source: LMDZ6/trunk/libf/phylmdiso/ajsec.F90 @ 5276

Last change on this file since 5276 was 5274, checked in by abarral, 23 hours ago

Replace yomcst.h by existing module
  • Property svn:keywords set to Id
File size: 18.0 KB
Line 
1
2! $Header$
3
4SUBROUTINE ajsec(paprs, pplay, t, q, limbas, d_t, d_q &
5#ifdef ISO     
6               ,xt,d_xt &
7#endif
8          )
9  USE dimphy
10#ifdef ISO
11    USE infotrac_phy, ONLY: ntraciso =>ntiso   
12#ifdef ISOVERIF
13  USE isotopes_mod, ONLY : iso_eau,iso_HDO
14  USE isotopes_verif_mod, ONLY: iso_verif_egalite, &
15        iso_verif_egalite_choix,iso_verif_noNaN,errmax,errmaxrel
16#ifdef ISOTRAC
17  USE isotopes_verif_mod, ONLY: iso_verif_traceur,iso_verif_traceur_justmass
18#endif
19#endif
20#endif
21  USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO                   &
22          , RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA                  &
23          , R_ecc, R_peri, R_incl                                      &
24          , RA, RG, R1SA                                         &
25          , RSIGMA                                                     &
26          , R, RMD, RMV, RD, RV, RCPD                    &
27          , RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12        &
28          , RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w                    &
29          , RCW, RCS                                                 &
30          , RLVTT, RLSTT, RLMLT, RTT, RATM                           &
31          , RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS            &
32          , RALPD, RBETD, RGAMD
33IMPLICIT NONE
34  ! ======================================================================
35  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
36  ! Objet: ajustement sec (adaptation du GCM du LMD)
37  ! ======================================================================
38  ! Arguments:
39  ! t-------input-R- Temperature
40
41  ! d_t-----output-R-Incrementation de la temperature
42  ! ======================================================================
43
44  REAL paprs(klon, klev+1), pplay(klon, klev)
45  REAL t(klon, klev), q(klon, klev)
46  REAL d_t(klon, klev), d_q(klon, klev)
47
48  INTEGER limbas(klon), limhau ! les couches a ajuster
49
50  LOGICAL mixq
51  ! cc      PARAMETER (mixq=.TRUE.)
52  PARAMETER (mixq=.FALSE.)
53
54  REAL zh(klon, klev)
55  REAL zho(klon, klev)
56  REAL zq(klon, klev)
57  REAL zpk(klon, klev)
58  REAL zpkdp(klon, klev)
59  REAL hm, sm, qm
60  LOGICAL modif(klon), down
61  INTEGER i, k, k1, k2
62#ifdef ISO
63      real xt(ntraciso,klon,klev)
64      real d_xt(ntraciso,klon,klev)
65      real zxt(ntraciso,klon,klev)
66      real xtm(ntraciso)
67      integer ixt
68#endif
69
70
71  ! Initialisation:
72
73#ifdef ISO
74#ifdef ISOVERIF
75      do i=1,klon
76         do k=1,klev         
77           if (iso_eau.gt.0) then
78             call iso_verif_egalite_choix(q(i,k),xt(iso_eau,i,k), &
79                 'ajsec 67',errmax,errmaxrel)
80           endif !if (iso_eau.gt.0) then
81         enddo !do k=limbas,limhau
82      enddo !do i=1,klon
83#endif
84#endif
85
86
87  ! ym
88  limhau = klev
89
90  DO k = 1, klev
91    DO i = 1, klon
92      d_t(i, k) = 0.0
93      d_q(i, k) = 0.0
94#ifdef ISO
95         do ixt=1,ntraciso
96            d_xt(ixt,i,k)=0.0
97         enddo
98#endif
99    END DO
100  END DO
101  ! ------------------------------------- detection des profils a modifier
102  DO k = 1, limhau
103    DO i = 1, klon
104      zpk(i, k) = pplay(i, k)**rkappa
105      zh(i, k) = rcpd*t(i, k)/zpk(i, k)
106      zho(i, k) = zh(i, k)
107      zq(i, k) = q(i, k)
108#ifdef ISO
109      do ixt=1,ntraciso
110            zxt(ixt,i,k)=xt(ixt,i,k)
111      enddo
112#endif
113    END DO
114  END DO
115
116  DO k = 1, limhau
117    DO i = 1, klon
118      zpkdp(i, k) = zpk(i, k)*(paprs(i,k)-paprs(i,k+1))
119    END DO
120  END DO
121
122  DO i = 1, klon
123    modif(i) = .FALSE.
124  END DO
125  DO k = 2, limhau
126    DO i = 1, klon
127      IF (.NOT. modif(i) .AND. k-1>limbas(i)) THEN
128        IF (zh(i,k)<zh(i,k-1)) modif(i) = .TRUE.
129      END IF
130    END DO
131  END DO
132  ! ------------------------------------- correction des profils instables
133  DO i = 1, klon
134    IF (modif(i)) THEN
135      k2 = limbas(i)
1368000  CONTINUE
137      k2 = k2 + 1
138      IF (k2>limhau) GO TO 8001
139      IF (zh(i,k2)<zh(i,k2-1)) THEN
140        k1 = k2 - 1
141        k = k1
142        sm = zpkdp(i, k2)
143        hm = zh(i, k2)
144        qm = zq(i, k2)
145#ifdef ISO
146        do ixt=1,ntraciso
147                 xtm(ixt)=zxt(ixt,i,k2)
148        enddo   
149#ifdef ISOVERIF
150        if (iso_eau.gt.0) then
151             call iso_verif_egalite_choix(qm,xtm(iso_eau), &
152                 'ajsec 126',errmax,errmaxrel)
153        endif !if (iso_eau.gt.0) then     
154#endif
155#endif
1568020    CONTINUE
157        sm = sm + zpkdp(i, k)
158        hm = hm + zpkdp(i, k)*(zh(i,k)-hm)/sm
159        qm = qm + zpkdp(i, k)*(zq(i,k)-qm)/sm
160#ifdef ISO
161        do ixt=1,ntraciso
162                 xtm(ixt)=xtm(ixt) &
163                    +zpkdp(i,k)*(zxt(ixt,i,k)-xtm(ixt))/sm
164        enddo   
165#ifdef ISOVERIF
166        if (iso_eau.gt.0) then
167             call iso_verif_egalite_choix(qm,xtm(iso_eau), &
168                 'ajsec 136',errmax,errmaxrel)
169        endif !if (iso_eau.gt.0) then     
170#endif
171#endif
172        down = .FALSE.
173        IF (k1/=limbas(i)) THEN
174          IF (hm<zh(i,k1-1)) down = .TRUE.
175        END IF
176        IF (down) THEN
177          k1 = k1 - 1
178          k = k1
179        ELSE
180          IF ((k2==limhau)) GO TO 8021
181          IF ((zh(i,k2+1)>=hm)) GO TO 8021
182          k2 = k2 + 1
183          k = k2
184        END IF
185        GO TO 8020
1868021    CONTINUE
187        ! ------------ nouveau profil : constant (valeur moyenne)
188        DO k = k1, k2
189          zh(i, k) = hm
190          zq(i, k) = qm
191#ifdef ISO
192                do ixt=1,ntraciso
193                   zxt(ixt,i,k)=xtm(ixt)
194                enddo
195#endif
196        END DO
197        k2 = k2 + 1
198      END IF
199      GO TO 8000
2008001  CONTINUE
201    END IF
202  END DO
203
204#ifdef ISO
205      ! cam verif
206#ifdef ISOVERIF
207      do i=1,klon
208         do k=1,klev
209           do ixt=1,ntraciso
210             call iso_verif_noNaN(zxt(ixt,i,k),'ajsec 173')
211           enddo !do ixt=1,niso           
212           if (iso_eau.gt.0) then
213             call iso_verif_egalite_choix(zq(i,k),zxt(iso_eau,i,k), &
214                 'ajsec 168',errmax,errmaxrel)
215           endif !if (iso_eau.gt.0) then
216#ifdef ISOTRAC     
217           call iso_verif_traceur(zxt(1,i,k),'ajsec 181')
218#endif           
219         enddo !do k=limbas,limhau
220      enddo !do i=1,klon
221#endif
222      ! end cam verif
223#endif
224
225  DO k = 1, limhau
226    DO i = 1, klon
227      d_t(i, k) = (zh(i,k)-zho(i,k))*zpk(i, k)/rcpd
228      d_q(i, k) = zq(i, k) - q(i, k)
229#ifdef ISO
230         do ixt=1,ntraciso
231            d_xt(ixt,i,k)=zxt(ixt,i,k)-xt(ixt,i,k)
232         enddo
233#endif
234    END DO
235  END DO
236
237#ifdef ISO
238      ! cam verif
239#ifdef ISOVERIF
240      do i = 1, klon
241        do k = 1, limhau
242         if (iso_eau.gt.0) then
243          call iso_verif_egalite_choix(d_q(i,k),d_xt(iso_eau,i,k), &
244                'ajsec 198',errmax,errmaxrel)
245         endif
246#ifdef ISOTRAC     
247        call iso_verif_traceur_justmass(d_xt(1,i,k),'physiq 210')
248#endif         
249         enddo
250      enddo
251#endif
252      ! end cam verif     
253#endif
254
255  ! FH : les d_q et d_t sont maintenant calcules de facon a valoir
256  ! effectivement 0. si on ne fait rien.
257
258  ! IF (limbas.GT.1) THEN
259  ! DO k = 1, limbas-1
260  ! DO i = 1, klon
261  ! d_t(i,k) = 0.0
262  ! d_q(i,k) = 0.0
263  ! ENDDO
264  ! ENDDO
265  ! ENDIF
266
267  ! IF (limhau.LT.klev) THEN
268  ! DO k = limhau+1, klev
269  ! DO i = 1, klon
270  ! d_t(i,k) = 0.0
271  ! d_q(i,k) = 0.0
272  ! ENDDO
273  ! ENDDO
274  ! ENDIF
275
276  IF (.NOT. mixq) THEN
277    DO k = 1, klev
278      DO i = 1, klon
279        d_q(i, k) = 0.0
280#ifdef ISO
281         do ixt=1,ntraciso
282            d_xt(ixt,i,k)=0.0
283         enddo
284#endif
285      END DO
286    END DO
287  END IF
288
289#ifdef ISO
290      ! cam verif
291#ifdef ISOVERIF
292      do i = 1, klon
293        do k = 1, klev
294         if (iso_eau.gt.0) then
295          call iso_verif_egalite(d_q(i,k),d_xt(iso_eau,i,k),'ajsec 270')
296         endif
297#ifdef ISOTRAC     
298        call iso_verif_traceur_justmass(d_xt(1,i,k),'physiq 3045')
299#endif         
300         enddo
301      enddo
302#endif
303      ! end cam verif
304#endif
305
306
307  RETURN
308END SUBROUTINE ajsec
309
310SUBROUTINE ajsec_convv2(paprs, pplay, t, q, d_t, d_q &
311#ifdef ISO
312           ,xt,d_xt &     
313#endif         
314        )
315  USE dimphy
316#ifdef ISO
317    USE infotrac_phy, ONLY: ntraciso=>ntiso   
318#ifdef ISOVERIF
319  USE isotopes_mod, ONLY : iso_eau,iso_HDO
320  USE isotopes_verif_mod, ONLY: iso_verif_egalite, &
321        iso_verif_egalite_choix,iso_verif_noNaN,errmax,errmaxrel
322#ifdef ISOTRAC
323  USE isotopes_verif_mod, ONLY: iso_verif_traceur,iso_verif_traceur_justmass
324#endif
325#endif
326#endif
327  USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO                   &
328          , RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA                  &
329          , R_ecc, R_peri, R_incl                                      &
330          , RA, RG, R1SA                                         &
331          , RSIGMA                                                     &
332          , R, RMD, RMV, RD, RV, RCPD                    &
333          , RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12        &
334          , RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w                    &
335          , RCW, RCS                                                 &
336          , RLVTT, RLSTT, RLMLT, RTT, RATM                           &
337          , RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS            &
338          , RALPD, RBETD, RGAMD
339IMPLICIT NONE
340  ! ======================================================================
341  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
342  ! Objet: ajustement sec (adaptation du GCM du LMD)
343  ! ======================================================================
344  ! Arguments:
345  ! t-------input-R- Temperature
346
347  ! d_t-----output-R-Incrementation de la temperature
348  ! ======================================================================
349
350  REAL paprs(klon, klev+1), pplay(klon, klev)
351  REAL t(klon, klev), q(klon, klev)
352  REAL d_t(klon, klev), d_q(klon, klev)
353
354  INTEGER limbas, limhau ! les couches a ajuster
355  ! cc      PARAMETER (limbas=klev-3, limhau=klev)
356  ! ym      PARAMETER (limbas=1, limhau=klev)
357
358  LOGICAL mixq
359  ! cc      PARAMETER (mixq=.TRUE.)
360  PARAMETER (mixq=.FALSE.)
361
362  REAL zh(klon, klev)
363  REAL zq(klon, klev)
364  REAL zpk(klon, klev)
365  REAL zpkdp(klon, klev)
366  REAL hm, sm, qm
367  LOGICAL modif(klon), down
368  INTEGER i, k, k1, k2
369
370#ifdef ISO
371      real xt(ntraciso,klon,klev)
372      real d_xt(ntraciso,klon,klev)
373      real zxt(ntraciso,klon,klev)
374      real xtm(ntraciso)
375      integer ixt
376#endif
377
378
379#ifdef ISO
380      ! cam verif
381#ifdef ISOVERIF
382      do i=1,klon
383         do k=1,klev
384           do ixt=1,ntraciso
385             call iso_verif_noNAN(xt(ixt,i,k),'ajsec 320')
386           enddo !do ixt=1,niso           
387           if (iso_eau.gt.0) then
388             call iso_verif_egalite_choix(q(i,k),xt(iso_eau,i,k), &
389                 'ajsec 324',errmax,errmaxrel)
390           endif !if (iso_eau.gt.0) then
391#ifdef ISOTRAC     
392           call iso_verif_traceur(xt(1,i,k),'ajsec 327')
393#endif           
394         enddo !do k=1,klev
395      enddo !do i=1,klon
396#endif
397      ! end cam verif
398#endif
399
400  ! Initialisation:
401
402  ! ym
403  limbas = 1
404  limhau = klev
405
406  DO k = 1, klev
407    DO i = 1, klon
408      d_t(i, k) = 0.0
409      d_q(i, k) = 0.0
410#ifdef ISO
411         do ixt=1,ntraciso
412            d_xt(ixt,i,k)=0.0
413         enddo
414#endif
415    END DO
416  END DO
417  ! ------------------------------------- detection des profils a modifier
418  DO k = limbas, limhau
419    DO i = 1, klon
420      zpk(i, k) = pplay(i, k)**rkappa
421      zh(i, k) = rcpd*t(i, k)/zpk(i, k)
422      zq(i, k) = q(i, k)
423#ifdef ISO
424         do ixt=1,ntraciso
425            zxt(ixt,i,k)=xt(ixt,i,k)
426         enddo
427#endif
428
429    END DO
430  END DO
431
432  DO k = limbas, limhau
433    DO i = 1, klon
434      zpkdp(i, k) = zpk(i, k)*(paprs(i,k)-paprs(i,k+1))
435    END DO
436  END DO
437
438  DO i = 1, klon
439    modif(i) = .FALSE.
440  END DO
441  DO k = limbas + 1, limhau
442    DO i = 1, klon
443      IF (.NOT. modif(i)) THEN
444        IF (zh(i,k)<zh(i,k-1)) modif(i) = .TRUE.
445      END IF
446    END DO
447  END DO
448  ! ------------------------------------- correction des profils instables
449  DO i = 1, klon
450    IF (modif(i)) THEN
451      k2 = limbas
4528000  CONTINUE
453      k2 = k2 + 1
454      IF (k2>limhau) GO TO 8001
455      IF (zh(i,k2)<zh(i,k2-1)) THEN
456        k1 = k2 - 1
457        k = k1
458        sm = zpkdp(i, k2)
459        hm = zh(i, k2)
460        qm = zq(i, k2)
461#ifdef ISO
462              do ixt=1,ntraciso
463                 xtm(ixt)=zxt(ixt,i,k2)
464              enddo
465#endif
4668020    CONTINUE
467        sm = sm + zpkdp(i, k)
468        hm = hm + zpkdp(i, k)*(zh(i,k)-hm)/sm
469        qm = qm + zpkdp(i, k)*(zq(i,k)-qm)/sm
470#ifdef ISO
471              do ixt=1,ntraciso
472                 xtm(ixt)=xtm(ixt) &
473                    +zpkdp(i,k)*(zxt(ixt,i,k)-xtm(ixt))/sm
474              enddo
475#endif
476        down = .FALSE.
477        IF (k1/=limbas) THEN
478          IF (hm<zh(i,k1-1)) down = .TRUE.
479        END IF
480        IF (down) THEN
481          k1 = k1 - 1
482          k = k1
483        ELSE
484          IF ((k2==limhau)) GO TO 8021
485          IF ((zh(i,k2+1)>=hm)) GO TO 8021
486          k2 = k2 + 1
487          k = k2
488        END IF
489        GO TO 8020
4908021    CONTINUE
491        ! ------------ nouveau profil : constant (valeur moyenne)
492        DO k = k1, k2
493          zh(i, k) = hm
494          zq(i, k) = qm
495#ifdef ISO
496                do ixt=1,ntraciso
497                   zxt(ixt,i,k)=xtm(ixt)
498                enddo
499#endif
500        END DO
501        k2 = k2 + 1
502      END IF
503      GO TO 8000
5048001  CONTINUE
505    END IF
506  END DO
507
508#ifdef ISO
509      ! cam verif
510#ifdef ISOVERIF
511      do i=1,klon
512         do k=limbas,limhau
513           do ixt=1,ntraciso
514             call iso_verif_noNAN(zxt(ixt,i,k),'ajsec 428')
515           enddo !do ixt=1,niso           
516           if (iso_eau.gt.0) then
517             call iso_verif_egalite_choix(zq(i,k),zxt(iso_eau,i,k), &
518                 'ajsec 432',errmax,errmaxrel)
519           endif !if (iso_eau.gt.0) then
520#ifdef ISOTRAC     
521           call iso_verif_traceur(zxt(1,i,k),'ajsec 436')
522#endif           
523         enddo !do k=limbas,limhau
524      enddo !do i=1,klon
525#endif
526      ! end cam verif
527#endif   
528
529
530  DO k = limbas, limhau
531    DO i = 1, klon
532      d_t(i, k) = zh(i, k)*zpk(i, k)/rcpd - t(i, k)
533      d_q(i, k) = zq(i, k) - q(i, k)
534#ifdef ISO
535         do ixt=1,ntraciso
536            d_xt(ixt,i,k)=zxt(ixt,i,k)-xt(ixt,i,k)
537         enddo
538#endif
539    END DO
540  END DO
541
542  IF (limbas>1) THEN
543    DO k = 1, limbas - 1
544      DO i = 1, klon
545        d_t(i, k) = 0.0
546        d_q(i, k) = 0.0
547#ifdef ISO
548         do ixt=1,ntraciso
549            d_xt(ixt,i,k)=0.0
550         enddo
551#endif
552      END DO
553    END DO
554  END IF
555
556  IF (limhau<klev) THEN
557    DO k = limhau + 1, klev
558      DO i = 1, klon
559        d_t(i, k) = 0.0
560        d_q(i, k) = 0.0
561#ifdef ISO
562         do ixt=1,ntraciso
563            d_xt(ixt,i,k)=0.0
564         enddo
565#endif
566      END DO
567    END DO
568  END IF
569
570  IF (.NOT. mixq) THEN
571    DO k = 1, klev
572      DO i = 1, klon
573        d_q(i, k) = 0.0
574#ifdef ISO
575         do ixt=1,ntraciso
576            d_xt(ixt,i,k)=0.0
577         enddo
578#endif
579      END DO
580    END DO
581  END IF
582
583
584#ifdef ISO
585      ! cam verif
586#ifdef ISOVERIF
587      do i = 1, klon
588        do k = limbas, limhau
589         if (iso_eau.gt.0) then
590          call iso_verif_egalite(d_q(i,k),d_xt(iso_eau,i,k),'ajsec 270')
591         endif
592#ifdef ISOTRAC     
593        call iso_verif_traceur_justmass(d_xt(1,i,k),'physiq 3045')
594#endif         
595         enddo
596      enddo
597#endif
598      ! end cam verif
599#endif
600
601  RETURN
602END SUBROUTINE ajsec_convv2
603SUBROUTINE ajsec_old(paprs, pplay, t, d_t)
604  USE dimphy
605  USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO                   &
606          , RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA                  &
607          , R_ecc, R_peri, R_incl                                      &
608          , RA, RG, R1SA                                         &
609          , RSIGMA                                                     &
610          , R, RMD, RMV, RD, RV, RCPD                    &
611          , RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12        &
612          , RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w                    &
613          , RCW, RCS                                                 &
614          , RLVTT, RLSTT, RLMLT, RTT, RATM                           &
615          , RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS            &
616          , RALPD, RBETD, RGAMD
617IMPLICIT NONE
618  ! ======================================================================
619  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
620  ! Objet: ajustement sec (adaptation du GCM du LMD)
621  ! ======================================================================
622  ! Arguments:
623  ! t-------input-R- Temperature
624
625  ! d_t-----output-R-Incrementation de la temperature
626  ! ======================================================================
627
628  REAL paprs(klon, klev+1), pplay(klon, klev)
629  REAL t(klon, klev)
630  REAL d_t(klon, klev)
631
632  REAL local_h(klon, klev)
633  REAL hm, sm
634  LOGICAL modif(klon), down
635  INTEGER i, l, l1, l2
636  ! ------------------------------------- detection des profils a modifier
637  DO i = 1, klon
638    modif(i) = .FALSE.
639  END DO
640
641  DO l = 1, klev
642    DO i = 1, klon
643      local_h(i, l) = rcpd*t(i, l)/(pplay(i,l)**rkappa)
644    END DO
645  END DO
646
647  DO l = 2, klev
648    DO i = 1, klon
649      IF (local_h(i,l)<local_h(i,l-1)) THEN
650        modif(i) = .TRUE.
651      ELSE
652        modif(i) = modif(i)
653      END IF
654    END DO
655  END DO
656  ! ------------------------------------- correction des profils instables
657  DO i = 1, klon
658    IF (modif(i)) THEN
659      l2 = 1
6608000  CONTINUE
661      l2 = l2 + 1
662      IF (l2>klev) GO TO 8001
663      IF (local_h(i,l2)<local_h(i,l2-1)) THEN
664        l1 = l2 - 1
665        l = l1
666        sm = pplay(i, l2)**rkappa*(paprs(i,l2)-paprs(i,l2+1))
667        hm = local_h(i, l2)
6688020    CONTINUE
669        sm = sm + pplay(i, l)**rkappa*(paprs(i,l)-paprs(i,l+1))
670        hm = hm + pplay(i, l)**rkappa*(paprs(i,l)-paprs(i,l+1))*(local_h(i,l) &
671          -hm)/sm
672        down = .FALSE.
673        IF (l1/=1) THEN
674          IF (hm<local_h(i,l1-1)) THEN
675            down = .TRUE.
676          END IF
677        END IF
678        IF (down) THEN
679          l1 = l1 - 1
680          l = l1
681        ELSE
682          IF ((l2==klev)) GO TO 8021
683          IF ((local_h(i,l2+1)>=hm)) GO TO 8021
684          l2 = l2 + 1
685          l = l2
686        END IF
687        GO TO 8020
6888021    CONTINUE
689        ! ------------ nouveau profil : constant (valeur moyenne)
690        DO l = l1, l2
691          local_h(i, l) = hm
692        END DO
693        l2 = l2 + 1
694      END IF
695      GO TO 8000
6968001  CONTINUE
697    END IF
698  END DO
699
700  DO l = 1, klev
701    DO i = 1, klon
702      d_t(i, l) = local_h(i, l)*(pplay(i,l)**rkappa)/rcpd - t(i, l)
703    END DO
704  END DO
705
706  RETURN
707END SUBROUTINE ajsec_old
Note: See TracBrowser for help on using the repository browser.