Changeset 3200 for LMDZ6/branches/IPSLCM6.0.15/libf/phylmd/acama_gwd_rando_m.F90

Timestamp:

Feb 12, 2018, 10:01:04 AM (6 years ago)

Author:

Laurent Fairhead

Message:

Inclusion of r3198 from trunk
Retour vers l'insensibilite au decoupage en sous domaine.
Les routines gwd_rando incluait le calcul de niveaux de reference
sur la base d'un profile pris au milieu du domaine (en klon/2).
Rempace par un test en presnivs.

Une autre intercation entre routines concernant la tke a fait apparaitre
que la tke n'?\195?\169tait pas passee correctement au niveau klev+1 au moment
du regroupement des mailles sous les sous surface.

Ces changements garantissent la convergence numerique si
addtkeoro=0
iflag_pbl<12
et
ok_gwd_rando=n
La convergence n'est pas garantie pour les dernieres versions des physiq.def
mais les differences devraient etre mineures.

FH

File:

• LMDZ6/branches/IPSLCM6.0.15/libf/phylmd/acama_gwd_rando_m.F90 (modified) (5 diffs)

LMDZ6/branches/IPSLCM6.0.15/libf/phylmd/acama_gwd_rando_m.F90

@@ -20 +20 @@
     use dimphy, only: klon, klev
     use assert_m, only: assert
+    USE ioipsl_getin_p_mod, ONLY : getin_p
+    USE vertical_layers_mod, ONLY : presnivs
+
     include "YOMCST.h"
     include "clesphys.h"
@@ -111 +114 @@
     REAL BV(KLON, KLEV + 1) ! Brunt Vaisala freq. (BVF) at 1/2 levels
     REAL BVSEC ! Security to avoid negative BVF
+
+    REAL, DIMENSION(klev+1) ::HREF
+    LOGICAL, SAVE :: gwd_reproductibilite_mpiomp=.true.
+    LOGICAL, SAVE :: firstcall = .TRUE.
+  !$OMP THREADPRIVATE(firstcall,gwd_reproductibilite_mpiomp)
+
+    CHARACTER (LEN=20) :: modname='flott_gwd_rando'
+    CHARACTER (LEN=80) :: abort_message
+
+
+
+  IF (firstcall) THEN
+    ! Cle introduite pour resoudre un probleme de non reproductibilite
+    ! Le but est de pouvoir tester de revenir a la version precedenete
+    ! A eliminer rapidement
+    CALL getin_p('gwd_reproductibilite_mpiomp',gwd_reproductibilite_mpiomp)
+    IF (NW+4*(NA-1)+NA>=KLEV) THEN
+       abort_message = 'NW+3*NA>=KLEV Probleme pour generation des ondes'
+       CALL abort_physic (modname,abort_message,1)
+    ENDIF
+    firstcall=.false.
+!    CALL iophys_ini
+  ENDIF
 
     !-----------------------------------------------------------------
@@ -205 +231 @@
     ! Launching altitude
 
+    IF (gwd_reproductibilite_mpiomp) THEN
+       ! Reprend la formule qui calcule PH en fonction de PP=play
+       DO LL = 2, KLEV
+          HREF(LL) = EXP((LOG(presnivs(LL)) + LOG(presnivs(LL - 1))) / 2.)
+       end DO
+       HREF(KLEV + 1) = 0.
+       HREF(1) = 2. * presnivs(1) - HREF(2)
+    ELSE
+       HREF(1:KLEV)=PH(KLON/2,1:KLEV)
+    ENDIF
+
     LAUNCH=0
     LTROP =0
     DO LL = 1, KLEV
-       IF (PH(KLON / 2, LL) / PH(KLON / 2, 1) > XLAUNCH) LAUNCH = LL
+       IF (HREF(LL) / HREF(1) > XLAUNCH) LAUNCH = LL
     ENDDO
     DO LL = 1, KLEV
-       IF (PH(KLON / 2, LL) / PH(KLON / 2, 1) > XTROP) LTROP = LL
+       IF (HREF(LL) / HREF(1) > XTROP) LTROP = LL
     ENDDO
 
@@ -293 +330 @@
 
     JW = 0
-    DO JP = 1, NP
-       DO JK = 1, NK
-          DO JO = 1, NO
-             JW = JW + 1
+    DO JW = 1, NW
              ! Angle
              DO II = 1, KLON
@@ -340 +374 @@
                 ! RUW0(JW, II) = RUWFRT
              ENDDO
-          end DO
-       end DO
     end DO