Skip to content
Snippets Groups Projects
Commit 9df193c7 authored by Thomas Feuvrier's avatar Thomas Feuvrier
Browse files

Add all 6SV1.0B files 4

parent 6be34b6f
No related branches found
No related tags found
No related merge requests found
Expand all Hide whitespace changes
Inline Side-by-side
Showing
with 5144 additions and 0 deletions
Utilities/otb6S/6SV1.0B/DISCOM.c 0 → 100644
+ 400
− 0
View file @ 9df193c7
/* DISCOM.f -- translated by f2c (version 19970805).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef __cplusplus
extern "C" {
#endif
/* OTB patches: replace "f2c.h" by "otb_6S_f2c.h" */
/*#include "f2c.h"*/
#include "otb_6S_f2c.h"
/* Common Block Declarations */
Extern struct {
integer nquad;
} num_quad__;
#define num_quad__1 num_quad__
Extern struct {
real phasel[20000] /* was [20][1000] */, qhasel[20000] /* was [20][
1000] */, uhasel[20000] /* was [20][1000] */;
} sixs_phase__;
#define sixs_phase__1 sixs_phase__
Extern struct {
real pha[1000], qha[1000], uha[1000], alphal[1001], betal[1001], gammal[
1001], zetal[1001];
} sixs_polar__;
#define sixs_polar__1 sixs_polar__
Extern struct {
real ext[20], ome[20], gasym[20], phase[20], qhase[20], uhase[20];
} sixs_aer__;
#define sixs_aer__1 sixs_aer__
Extern struct {
real roatm[60] /* was [3][20] */, dtdir[60] /* was [3][20] */,
dtdif[60] /* was [3][20] */, utdir[60] /* was [3][20] */,
utdif[60] /* was [3][20] */, sphal[60] /* was [3][20] */,
wldis[20], trayl[20], traypl[20], rqatm[60] /* was [3][20] */,
ruatm[60] /* was [3][20] */;
} sixs_disc__;
#define sixs_disc__1 sixs_disc__
Extern struct {
real s[1501], wlinf, wlsup;
} sixs_ffu__;
#define sixs_ffu__1 sixs_ffu__
Extern struct {
integer num_z__;
real alt_z__[101], taer_z__[101], taer55_z__[101];
} aeroprof_;
#define aeroprof_1 aeroprof_
/*< >*/
/* Subroutine */ int discom_(integer *idatmp, integer *iaer, integer *
iaer_prof__, real *xmus, real *xmuv, real *phi, real *taer55, real *
taer55p, real *palt, real *phirad, integer *nt, integer *mu, integer *
np, real *rm, real *gb, real *rp, real *ftray, integer *ipol, real *
xlm1, real *xlm2, real *roatm_fi__, integer *nfi, integer *nfilut,
real *filut, real *roluts, real *rolutsq, real *rolutsu)
{
/* System generated locals */
integer rm_offset, gb_offset, xlm1_dim1, xlm1_offset, xlm2_dim1,
xlm2_offset, roluts_dim2, roluts_offset, rolutsq_dim2,
rolutsq_offset, rolutsu_dim2, rolutsu_offset, filut_dim1,
filut_offset, i__1;
/* Local variables */
real romix_fi__[181];
integer i__, j, k, l;
real rorayl_fi__[181], wl;
integer ifi;
real taer, nbmu, piza, tray, coeff, taerp, tamoy, romix, trayp, rqmix,
rumix, rolut[1025] /* was [25][41] */, ddifta, ddirta, ddiftt,
ddiftr, udifta;
extern /* Subroutine */ int atmref_(integer *, integer *, real *, real *,
real *, real *, real *, real *, real *, real *, real *, real *,
real *, real *, real *, integer *, integer *, integer *, real *,
real *, real *, real *, real *, real *, real *, real *, real *,
real *, real *, real *, integer *, real *, real *, real *, real *,
integer *, integer *, real *, real *, real *, real *);
real roaero, ddirtr, rqaero, ddirtt, udirta;
extern /* Subroutine */ int odrayl_(real *, real *);
real ruaero, udiftr, udiftt;
extern /* Subroutine */ int trunca_(real *, integer *), scatra_(integer *,
real *, real *, real *, real *, real *, real *, integer *,
integer *, real *, real *, real *, real *, real *, real *, real *,
real *, real *, real *, real *, real *, real *, real *, real *,
real *, real *, real *, real *);
real rorayl, tamoyp, rqrayl, udirtt, udirtr, rurayl, rolutq[1025] /*
was [25][41] */, pizmoy, rolutu[1025] /* was [25][41] */,
sphalba, sphalbr, sphalbt;
/* - to vary the number of quadratures */
/*< include "paramdef.inc" >*/
/*< integer nquad >*/
/*< parameter (nt_p_max=100,nqmax_p=1000,nqdef_p=83) ! do not change >*/
/* Attention */
/* mu2_p has to be equal to (mu_p-1)*2 */
/*< common /num_quad/ nquad >*/
/*< real phasel,qhasel,uhasel >*/
/*< >*/
/*< real pha,qha,uha,alphal,betal,gammal,zetal >*/
/*< >*/
/*< real nbmu >*/
/* - to vary the number of quadratures */
/*< integer mu,np,ipol >*/
/*< integer idatmp,iaer,nt,l,k >*/
/*< real rm(-mu:mu),rp(np),gb(-mu:mu) >*/
/*< real ftray,xlm1(-mu:mu,np),xlm2(-mu:mu,np) >*/
/*< real roatm_fi(3,20,nfi) >*/
/* THOMAS */
/* real rorayl_fi(nfi),romix_fi(nfi) */
/*< real rorayl_fi(181),romix_fi(181) >*/
/* THOMAS */
/* real rolut(mu,41) */
/*< real rolut(25,41) >*/
/*< real roluts(20,mu,41) >*/
/* THOMAS */
/* real rolutq(mu,41) */
/*< real rolutq(25,41) >*/
/*< real rolutsq(20,mu,41) >*/
/* THOMAS */
/* real rolutu(mu,41) */
/*< real rolutu(25,41) >*/
/*< real rolutsu(20,mu,41) >*/
/*< real filut(mu,41) >*/
/*< integer nfilut(mu) >*/
/*< real xmus,xmuv,phi >*/
/*< real taer55,taer55p,palt,phirad,ext,ome,gasym,phase,roatm >*/
/*< real dtdir,dtdif,utdir,utdif,sphal,wldis,trayl,traypl,s >*/
/*< real wlinf,wlsup,wl,tray,trayp,taer >*/
/*< real rqatm,ruatm,rurayl,ruaero,rumix,qhase,uhase >*/
/*< real taerp,piza,tamoy,tamoyp,pizmoy,rorayl,rqrayl,rqmix,rqaero >*/
/*< real roaero,romix,ddirtt,ddiftt,udirtt,udiftt,sphalbt,ddirtr >*/
/*< real ddiftr,udirtr,udiftr,sphalbr,ddirta,ddifta,udirta,udifta >*/
/*< real sphalba,coeff >*/
/*< >*/
/*< >*/
/*< common /sixs_ffu/s(1501),wlinf,wlsup >*/
/*< real alt_z,taer_z,taer55_z >*/
/*< >*/
/*< integer iaer_prof >*/
/* computation of all scattering parameters at wavelength */
/* discrete values,so we can interpolate at any wavelength */
/*< do 50 l=1,20 >*/
/* Parameter adjustments */
rolutsu_dim2 = *mu;
rolutsu_offset = (rolutsu_dim2 + 1) * 20 + 1;
rolutsu -= rolutsu_offset;
rolutsq_dim2 = *mu;
rolutsq_offset = (rolutsq_dim2 + 1) * 20 + 1;
rolutsq -= rolutsq_offset;
roluts_dim2 = *mu;
roluts_offset = (roluts_dim2 + 1) * 20 + 1;
roluts -= roluts_offset;
filut_dim1 = *mu;
filut_offset = filut_dim1 + 1;
filut -= filut_offset;
--nfilut;
gb_offset = -(*mu);
gb -= gb_offset;
rm_offset = -(*mu);
rm -= rm_offset;
xlm2_dim1 = *mu - (-(*mu)) + 1;
xlm2_offset = -(*mu) + xlm2_dim1;
xlm2 -= xlm2_offset;
xlm1_dim1 = *mu - (-(*mu)) + 1;
xlm1_offset = -(*mu) + xlm1_dim1;
xlm1 -= xlm1_offset;
--rp;
roatm_fi__ -= 64;
/* Function Body */
for (l = 1; l <= 20; ++l) {
/*< wl=wldis(l) >*/
wl = sixs_disc__1.wldis[l - 1];
/*< if ((wlsup.lt.wldis(1)).and.(l.le.2)) goto 30 >*/
if (sixs_ffu__1.wlsup < sixs_disc__1.wldis[0] && l <= 2) {
goto L30;
}
/*< if (wlinf.gt.wldis(20).and.(l.ge.19)) goto 30 >*/
if (sixs_ffu__1.wlinf > sixs_disc__1.wldis[19] && l >= 19) {
goto L30;
}
/*< >*/
if (l < 20 && sixs_disc__1.wldis[l - 1] < sixs_ffu__1.wlinf &&
sixs_disc__1.wldis[l] < sixs_ffu__1.wlinf) {
goto L50;
}
/*< >*/
if (l > 1 && sixs_disc__1.wldis[l - 1] > sixs_ffu__1.wlsup &&
sixs_disc__1.wldis[l - 2] > sixs_ffu__1.wlsup) {
goto L50;
}
/* computation of rayleigh optical depth at wl */
/*< 30 call odrayl(wl,tray) >*/
L30:
odrayl_(&wl, &tray);
/* plane case discussed here above */
/*< if (idatmp.eq.0.or.idatmp.eq.4) then >*/
if (*idatmp == 0 || *idatmp == 4) {
/*< if (idatmp.eq.4) trayp=tray >*/
if (*idatmp == 4) {
trayp = tray;
}
/*< if (idatmp.eq.0) trayp=0. >*/
if (*idatmp == 0) {
trayp = (float)0.;
}
/*< else >*/
} else {
/*< trayp=tray*ftray >*/
trayp = tray * *ftray;
/*< endif >*/
}
/*< trayl(l)=tray >*/
sixs_disc__1.trayl[l - 1] = tray;
/*< traypl(l)=trayp >*/
sixs_disc__1.traypl[l - 1] = trayp;
/* computation of aerosol optical properties at wl */
/*< taer=taer55*ext(l) >*/
taer = *taer55 * sixs_aer__1.ext[l - 1];
/*< taerp=taer55p*ext(l) >*/
taerp = *taer55p * sixs_aer__1.ext[l - 1];
/*< piza=ome(l) >*/
piza = sixs_aer__1.ome[l - 1];
/* - in case of the user-defined aerosol profile */
/*< do i=1,num_z >*/
i__1 = aeroprof_1.num_z__;
for (i__ = 1; i__ <= i__1; ++i__) {
/*< taer_z(i)=taer55_z(i)*ext(l) >*/
aeroprof_1.taer_z__[i__] = aeroprof_1.taer55_z__[i__] *
sixs_aer__1.ext[l - 1];
/*< enddo >*/
}
/* - in case of the user-defined aerosol profile */
/* computation of atmospheric reflectances */
/* rorayl is rayleigh ref */
/* roaero is aerosol ref */
/* call trunca to decompose aerosol phase function in */
/* Legendre polynomials. */
/*< nbmu=nquad >*/
nbmu = (real) num_quad__1.nquad;
/*< do k=1,nbmu >*/
i__1 = nbmu;
for (k = 1; k <= i__1; ++k) {
/*< pha(k)=phasel(l,k) >*/
sixs_polar__1.pha[k - 1] = sixs_phase__1.phasel[l + k * 20 - 21];
/*< enddo >*/
}
/*< if (ipol.ne.0)then >*/
if (*ipol != 0) {
/*< do k=1,nbmu >*/
i__1 = nbmu;
for (k = 1; k <= i__1; ++k) {
/*< qha(k)=qhasel(l,k) >*/
sixs_polar__1.qha[k - 1] = sixs_phase__1.qhasel[l + k * 20 -
21];
/*< uha(k)=uhasel(l,k) >*/
sixs_polar__1.uha[k - 1] = sixs_phase__1.uhasel[l + k * 20 -
21];
/*< enddo >*/
}
/*< endif >*/
}
/*< if (iaer.ne.0) call trunca(coeff,ipol) ! the routine is modified >*/
if (*iaer != 0) {
trunca_(&coeff, ipol);
}
/*< tamoy=taer*(1.-piza*coeff) >*/
tamoy = taer * ((float)1. - piza * coeff);
/*< tamoyp=taerp*(1.-piza*coeff) >*/
tamoyp = taerp * ((float)1. - piza * coeff);
/*< pizmoy=piza*(1.-coeff)/(1.-piza*coeff) >*/
pizmoy = piza * ((float)1. - coeff) / ((float)1. - piza * coeff);
/*< >*/
atmref_(iaer, iaer_prof__, &tamoy, &taer, &tray, &pizmoy, &piza, &
tamoyp, &taerp, &trayp, palt, phi, xmus, xmuv, phirad, nt, mu,
np, &rm[rm_offset], &gb[gb_offset], &rp[1], &rorayl, &roaero,
&romix, &rqrayl, &rqaero, &rqmix, &rurayl, &ruaero, &rumix,
ipol, &xlm1[xlm1_offset], &xlm2[xlm2_offset], rorayl_fi__,
romix_fi__, nfi, &nfilut[1], &filut[filut_offset], rolut,
rolutq, rolutu);
/*< roatm(1,l)=rorayl >*/
sixs_disc__1.roatm[l * 3 - 3] = rorayl;
/*< roatm(2,l)=romix >*/
sixs_disc__1.roatm[l * 3 - 2] = romix;
/*< roatm(3,l)=roaero >*/
sixs_disc__1.roatm[l * 3 - 1] = roaero;
/* write(6,*) 'rorayl',rorayl */
/* write(6,*)'romix',romix */
/* write(6,*)'roaero',roaero */
/*< rqatm(1,l)=rqrayl >*/
sixs_disc__1.rqatm[l * 3 - 3] = rqrayl;
/*< rqatm(2,l)=rqmix >*/
sixs_disc__1.rqatm[l * 3 - 2] = rqmix;
/*< rqatm(3,l)=rqaero >*/
sixs_disc__1.rqatm[l * 3 - 1] = rqaero;
/* write(6,*) 'rqrayl',rqrayl */
/* write(6,*)'rqmix',rqmix */
/* write(6,*)'rqaero',rqaero */
/*< ruatm(1,l)=rurayl >*/
sixs_disc__1.ruatm[l * 3 - 3] = rurayl;
/*< ruatm(2,l)=rumix >*/
sixs_disc__1.ruatm[l * 3 - 2] = rumix;
/*< ruatm(3,l)=ruaero >*/
sixs_disc__1.ruatm[l * 3 - 1] = ruaero;
/* write(6,*) 'rurayl',rurayl */
/* write(6,*)'rumix',rumix */
/* write(6,*)'ruaero',ruaero */
/*< do ifi=1,nfi >*/
i__1 = *nfi;
for (ifi = 1; ifi <= i__1; ++ifi) {
/*< roatm_fi(1,l,ifi)=rorayl_fi(ifi) >*/
roatm_fi__[(l + ifi * 20) * 3 + 1] = rorayl_fi__[ifi - 1];
/*< roatm_fi(2,l,ifi)=romix_fi(ifi) >*/
roatm_fi__[(l + ifi * 20) * 3 + 2] = romix_fi__[ifi - 1];
/*< enddo >*/
}
/*< do i=1,mu >*/
i__1 = *mu;
for (i__ = 1; i__ <= i__1; ++i__) {
/*< do j=1,41 >*/
for (j = 1; j <= 41; ++j) {
/*< roluts(l,i,j)=rolut(i,j) >*/
roluts[l + (i__ + j * roluts_dim2) * 20] = rolut[i__ + j * 25
- 26];
/*< rolutsq(l,i,j)=rolutq(i,j) >*/
rolutsq[l + (i__ + j * rolutsq_dim2) * 20] = rolutq[i__ + j *
25 - 26];
/*< rolutsu(l,i,j)=rolutu(i,j) >*/
rolutsu[l + (i__ + j * rolutsu_dim2) * 20] = rolutu[i__ + j *
25 - 26];
/*< enddo >*/
}
/*< enddo >*/
}
/* computation of scattering transmitances (direct and diffuse) */
/* first time for rayleigh ,next total (rayleigh+aerosols) */
/*< >*/
scatra_(iaer_prof__, &tamoy, &tamoyp, &tray, &trayp, &pizmoy, palt,
nt, mu, &rm[rm_offset], &gb[gb_offset], xmus, xmuv, &ddirtt, &
ddiftt, &udirtt, &udiftt, &sphalbt, &ddirtr, &ddiftr, &udirtr,
&udiftr, &sphalbr, &ddirta, &ddifta, &udirta, &udifta, &
sphalba);
/*< dtdir(1,l)=ddirtr >*/
sixs_disc__1.dtdir[l * 3 - 3] = ddirtr;
/*< dtdif(1,l)=ddiftr >*/
sixs_disc__1.dtdif[l * 3 - 3] = ddiftr;
/*< dtdir(2,l)=ddirtt >*/
sixs_disc__1.dtdir[l * 3 - 2] = ddirtt;
/*< dtdif(2,l)=ddiftt >*/
sixs_disc__1.dtdif[l * 3 - 2] = ddiftt;
/*< dtdir(3,l)=ddirta >*/
sixs_disc__1.dtdir[l * 3 - 1] = ddirta;
/*< dtdif(3,l)=ddifta >*/
sixs_disc__1.dtdif[l * 3 - 1] = ddifta;
/*< utdir(1,l)=udirtr >*/
sixs_disc__1.utdir[l * 3 - 3] = udirtr;
/*< utdif(1,l)=udiftr >*/
sixs_disc__1.utdif[l * 3 - 3] = udiftr;
/*< utdir(2,l)=udirtt >*/
sixs_disc__1.utdir[l * 3 - 2] = udirtt;
/*< utdif(2,l)=udiftt >*/
sixs_disc__1.utdif[l * 3 - 2] = udiftt;
/*< utdir(3,l)=udirta >*/
sixs_disc__1.utdir[l * 3 - 1] = udirta;
/*< utdif(3,l)=udifta >*/
sixs_disc__1.utdif[l * 3 - 1] = udifta;
/*< sphal(1,l)=sphalbr >*/
sixs_disc__1.sphal[l * 3 - 3] = sphalbr;
/*< sphal(2,l)=sphalbt >*/
sixs_disc__1.sphal[l * 3 - 2] = sphalbt;
/*< sphal(3,l)=sphalba >*/
sixs_disc__1.sphal[l * 3 - 1] = sphalba;
/*< 50 continue >*/
L50:
;
}
/*< return >*/
return 0;
/*< end >*/
} /* discom_ */
#ifdef __cplusplus
}
#endif
Utilities/otb6S/6SV1.0B/ENVIRO.P 0 → 100644
+ 1
− 0
View file @ 9df193c7
extern int enviro_(real *difr, real *difa, real *r__, real *palt, real *xmuv, real *fra, real *fae, real *fr);
Utilities/otb6S/6SV1.0B/GOES.P 0 → 100644
+ 2
− 0
View file @ 9df193c7
extern int goes_(integer *iwa);
/* comlen sixs_ffu__ 6012 */
Utilities/otb6S/6SV1.0B/IAPIBRDF.f 0 → 100755
+ 154
− 0
View file @ 9df193c7
subroutine iapibrdf(pild,pxlt,prl,ptl,prs,pihs,pc,mu,np,rm,rp,
s brdfint)
c
c interface between the computer code of the model of Iaquinta and Pinty
c the computer code is courtesy of Jean Ianquinta
c see module IAPITOOLS.f for a complete description
c
c
integer np,mu
real rm(-mu:mu),rp(np),brdfint(-mu:mu,np)
real ro_1
integer iwr,k,j
integer pild,pihs
real pxlt,prl,ptl,prs,pc
logical ier
common/sixs_ier/iwr,ier
c
real mu1,mu2,fi
real pi
C begin of Iaquinta and Pinty model parameter and declaration
parameter (Pi=3.141592653589793)
common /gauss_m/xgm (20),wgm (20),n
real xgm,wgm
integer n
common /p/xLt,Rl,Tl,Rs,c,ild
real xLt,Rl,Tl,Rs,c
integer ild
common /ld/a_ld,b_ld,c_ld,d_ld
real a_ld,b_ld,c_ld,d_ld
common /Ro/Ro_1_c,Ro_1_s,Ro_mult
real Ro_1_c,Ro_1_s,Ro_mult
real Theta_i,Phi_i
real Theta_v,Phi_v
integer ihs
c xLt = leaf area index
c Rl = leaf reflection coefficient (Bi-Lambertian)
c Tl = leaf transmission coefficient (Bi-Lambertian)
c ild = leaf angle distribution :
c 1 = planophile
c 2 = erectophile
c 3 = plagiophile
c 4 = extremophile
c 5 = uniform
c Rs = soil albedo
c c = 2*r*Lambda
c
c Ro_1_c = single scattering by the canopy term
c Ro_1_s = uncollided by the leaves (or singly scattered by
c the soil) radiation
c (Ro_1 = Ro_1_c + Ro_1_s)
c Ro_mult = multiple scattering
c transfer paramater to common / / parameter struture
ild=pild
Xlt=pXlt
Rl=pRl
Tl=pTl
Rs=pRs
ihs=pihs
c=pc
C
C Check parameter validity
if ((ild.ne.1).and.
+ (ild.ne.2).and.
+ (ild.ne.3).and.
+ (ild.ne.4).and.
+ (ild.ne.5)) then
print*,'Leaf angle distribution !'
stop
endif
if (xlt.le.0.) then
print*,'Leaf area index < 0. !'
stop
endif
if (xlt.lt.1.) then
print*,'Leaf area index < 1. !'
endif
if (xlt.gt.15.) then
print*,'Leaf area index > 15. !'
endif
if (Rl.lt.0.) then
print*,'Leaf reflectance < 0. !'
stop
endif
if (Rl.gt..99) then
print*,'Leaf reflectance > .99 !'
stop
endif
if (Tl.lt.0.) then
print*,'Leaf transmittance < 0. !'
stop
endif
if (Tl.gt..99) then
print*,'Leaf transmittance > .99 !'
stop
endif
if (Rl+Tl.gt..99) then
print*,'Single scattering albedo > .99 !'
stop
endif
if (Rs.lt.0.) then
print*,'Soil albedo < 0. !'
stop
endif
if (Rs.gt..99) then
print*,'Soil albedo > .99 !'
stop
endif
if (c.lt.0.) then
print*,'Hot-spot parameter < 0. !'
stop
endif
if (c.gt.2.) then
print*,'Hot-spot parameter > 2. !'
stop
endif
C compute leaf area angle distribution
call lad
C
c - Hot-spot parameter
c
if (ihs.eq.0) c=0.
C
mu1=rm(0)
Theta_i=acos(mu1)
Theta_i=Pi-Theta_i
c
c
c - Gauss's quadrature (n points)
c
n=10
call gauleg (-1.,1.,xgm,wgm,n)
c
c - Computation of the multiple scattering (Ro_mult)
c
call solve (Theta_i)
C
do 1 k=1,np
do 2 j=1,mu
mu2=rm(j)
if (j.eq.mu) then
fi=rm(-mu)
else
fi=rp(k)+rm(-mu)
endif
Theta_v=acos(mu2)
if (fi.lt.0.) fi=fi+2.*pi
if (fi.gt.(2.*pi)) fi=fi-2.*pi
Phi_i=fi
Phi_v=0.
brdfint(j,k)=Ro_1(Theta_i,Phi_i,Theta_v,Phi_v)+Ro_mult
2 continue
1 continue
return
end
Utilities/otb6S/6SV1.0B/LAKEW.P 0 → 100644
+ 1
− 0
View file @ 9df193c7
extern int lakew_(real *r__);
Utilities/otb6S/6SV1.0B/MERIS.c 0 → 100644
+ 3634
− 0
View file @ 9df193c7
Source diff could not be displayed: it is too large. Options to address this: view the blob.
Utilities/otb6S/6SV1.0B/MOCA6.c 0 → 100644
+ 438
− 0
View file @ 9df193c7
This diff is collapsed.
Utilities/otb6S/6SV1.0B/MODISBRDF.P 0 → 100644
+ 1
− 0
View file @ 9df193c7
extern int modisbrdf_(real *p1, real *p2, real *p3, integer *mu, integer *np, real *rm, real *rp, real *brdfint);
Utilities/otb6S/6SV1.0B/NIOX6.c 0 → 100644
+ 438
− 0
View file @ 9df193c7
This diff is collapsed.
Utilities/otb6S/6SV1.0B/OXYG3.P 0 → 100644
+ 1
− 0
View file @ 9df193c7
extern int oxyg3_(real *a, integer *inu);
Utilities/otb6S/6SV1.0B/SUBWIN.P 0 → 100644
+ 2
− 0
View file @ 9df193c7
extern int subwin_();
/* comlen sixs_atm__ 680 */
Utilities/otb6S/6SV1.0B/VARSOL.c 0 → 100644
+ 70
− 0
View file @ 9df193c7
/* VARSOL.f -- translated by f2c (version 19970805).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#ifdef __cplusplus
extern "C" {
#endif
/* OTB patches: replace "f2c.h" by "otb_6S_f2c.h" */
/*#include "f2c.h"*/
#include "otb_6S_f2c.h"
/*< >*/
/* Subroutine */ int varsol_(integer *jday, integer *month, real *dsol)
{
/* System generated locals */
real r__1;
/* Builtin functions */
double acos(doublereal), cos(doublereal);
/* Local variables */
integer j;
real pi, om;
/*< real dsol,pi,om >*/
/*< integer jday,month,j >*/
/* calculation of the variability of the solar constant during the */
/* year. */
/* jday is the number of the day in the month */
/* dsol is a multiplicative factor to apply to the mean value of */
/* solar constant */
/*< if (month.le.2) goto 1 >*/
if (*month <= 2) {
goto L1;
}
/*< if (month.gt.8) goto 2 >*/
if (*month > 8) {
goto L2;
}
/*< j=31*(month-1)-((month-1)/2)-2+jday >*/
j = (*month - 1) * 31 - (*month - 1) / 2 - 2 + *jday;
/*< goto 3 >*/
goto L3;
/*< 1 j=31*(month-1)+jday >*/
L1:
j = (*month - 1) * 31 + *jday;
/*< goto 3 >*/
goto L3;
/*< 2 j=31*(month-1)-((month-2)/2)-2+jday >*/
L2:
j = (*month - 1) * 31 - (*month - 2) / 2 - 2 + *jday;
/*< 3 pi=2.*acos (0.) >*/
L3:
pi = acos((float)0.) * (float)2.;
/*< om=(.9856*float(j-4))*pi/180. >*/
om = (real) (j - 4) * (float).9856 * pi / (float)180.;
/*< dsol=1./((1.-.01673*cos(om))**2) >*/
/* Computing 2nd power */
r__1 = (float)1. - cos(om) * (float).01673;
*dsol = (float)1. / (r__1 * r__1);
/*< return >*/
return 0;
/*< end >*/
} /* varsol_ */
#ifdef __cplusplus
}
#endif
Utilities/otb6S/6SV1.0B/WAVA1.P 0 → 100644
+ 1
− 0
View file @ 9df193c7
extern int wava1_(real *a, integer *inu);
Utilities/otb6S/6SV1.0B/WAVA5.P 0 → 100644
+ 1
− 0
View file @ 9df193c7
extern int wava5_(real *a, integer *inu);
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment