source: trunk/LMDZ.TITAN.old/libf/phytitan/dsolver.F @ 3303

Last change on this file since 3303 was 3, checked in by slebonnois, 14 years ago

Creation de repertoires:

  • chantiers : pour communiquer sur nos projets de modifs
  • documentation : pour stocker les docs

Ajout de:

  • libf/phytitan : physique de Titan
  • libf/chimtitan: chimie de Titan
  • libf/phyvenus : physique de Venus
File size: 3.2 KB
Line 
1      SUBROUTINE DSOLVER(NL,GAMA,CP,CM,CPM1,CMM1
2     ,,E1,E2,E3,E4,BTOP,BSURF,RSF,XK1,XK2)
3C VERSION OF SOLVER
4c     PARAMETER (NMAX=201)
5      PARAMETER (NMAX=401)
6      IMPLICIT REAL  (A-H,O-Z)
7      DIMENSION GAMA(NL),CP(NL),CM(NL),
8     ,CPM1(NL),CMM1(NL),XK1(NL),XK2(NL)
9     ,,E1(NL),E2(NL),E3(NL),E4(NL)
10      DIMENSION AF(NMAX),BF(NMAX),CF(NMAX),DF(NMAX),XK(NMAX)
11C*********************************************************
12C* THIS SUBROUTINE SOLVES FOR THE COEFFICIENTS OF THE    *
13C* TWO STREAM SOLUTION FOR GENERAL BOUNDARY CONDITIONS   *
14C* NO ASSUMPTION OF THE DEPENDENCE ON OPTICAL DEPTH OF   *
15C* C-PLUS OR C-MINUS HAS BEEN MADE.                      *
16C* NL     = NUMBER OF LAYERS IN THE MODEL                *
17C* CP     = C-PLUS EVALUATED AT TAO=0 (TOP)              *
18C* CM     = C-MINUS EVALUATED AT TAO=0 (TOP)             *
19C* CPM1   = C-PLUS  EVALUATED AT TAOSTAR (BOTTOM)        *
20C* CMM1   = C-MINUS EVALUATED AT TAOSTAR (BOTTOM)        *
21C* EP     = EXP(LAMDA*DTAU)                              *
22C* EM     = 1/EP                                         *
23C* E1     = EP + GAMA *EM                                *
24C* E2     = EP - GAMA *EM                                *
25C* E3     = GAMA*EP + EM                                 *
26C* E4     = GAMA*EP - EM                                 *
27C* BTOP   = THE DIFFUSE RADIATION INTO THE MODEL AT TOP  *
28C* BSURF  = THE DIFFUSE RADIATION INTO THE MODEL AT      *
29C*          THE BOTTOM: INCLUDES EMMISION AND REFLECTION *
30C*          OF THE UNATTENUATED PORTION OF THE DIRECT    *
31C*          BEAM. BSTAR+RSF*FO*EXP(-TAOSTAR/U0)          *
32C* RSF    = REFLECTIVITY OF THE SURFACE                  *
33C* XK1    = COEFFICIENT OF THE POSITIVE EXP TERM         *
34C* XK2    = COEFFICIENT OF THE NEGATIVE EXP TERM         *
35C*********************************************************
36      L=2*NL
37C************MIXED COEFFICENTS**********
38C* THIS VERSION AVOIDS SINGULARITIES ASSOC.
39C* WIRH W0=0 BY SOLVING FOR XK1+XK2, AND XK1-XK2.
40      AF(1)=0.0
41      BF(1)=GAMA(1)+1.
42      CF(1)=GAMA(1)-1.
43      DF(1)=BTOP-CMM1(1)
44      N=0
45      LM2=L-2
46C* EVEN TERMS
47      DO 10 I=2,LM2,2
48          N=N+1
49          AF(I)=(E1(N)+E3(N))*(GAMA(N+1)-1.)
50          BF(I)=(E2(N)+E4(N))*(GAMA(N+1)-1.)
51          CF(I)=2.*(1.-GAMA(N+1)**2)
52          DF(I)=(GAMA(N+1)-1.) * (CPM1(N+1) - CP(N))
53     &          + (1.-GAMA(N+1))* (CM(N)-CMM1(N+1))
54   10 CONTINUE
55      N=0
56      LM1=L-1
57      DO 20 I=3,LM1,2
58          N=N+1
59          AF(I)=2.*(1.-GAMA(N)**2)
60          BF(I)=(E1(N)-E3(N))*(1.+GAMA(N+1))
61          CF(I)=(E1(N)+E3(N))*(GAMA(N+1)-1.)
62          DF(I)=E3(N)*(CPM1(N+1) - CP(N))
63     &         + E1(N)*(CM(N) - CMM1(N+1))
64   20 CONTINUE
65      AF(L)=E1(NL)-RSF*E3(NL)
66      BF(L)=E2(NL)-RSF*E4(NL)
67      CF(L)=0.0
68      DF(L)=BSURF-CP(NL)+RSF*CM(NL)
69      CALL DTRIDGL(L,AF,BF,CF,DF,XK)
70C***UNMIX THE COEFFICIENTS****
71      DO 28 N=1,NL
72      XK1(N)=XK(2*N-1)+XK(2*N)
73      XK2(N)=XK(2*N-1)-XK(2*N)
74C NOW TEST TO SEE IF XK2 IS REALLY ZERO TO THE LIMIT OF THE
75C MACHINE ACCURACY  = 1 .E -30
76C XK2 IS THE COEFFICEINT OF THE GROWING EXPONENTIAL AND MUST
77C BE TREATED CAREFULLY
78      IF (XK2(N) .EQ. 0.0) GO TO 28
79      IF (ABS (XK2(N)/XK(2*N-1)) .LT. 1.E-30) XK2(N)=0.0
80   28 CONTINUE
81      RETURN
82      END
Note: See TracBrowser for help on using the repository browser.