Changeset 5223 for LMDZ6/branches/Amaury_dev/libf/dyn3d_common/iso_verif_dyn.f90

Timestamp:

Sep 23, 2024, 4:45:12 PM (7 weeks ago)

Author:

abarral

Message:

Merge r5200

Location:

LMDZ6/branches/Amaury_dev

Files:

• . (modified) (1 prop)
• libf/dyn3d_common/iso_verif_dyn.f90 (modified) (1 diff)

LMDZ6/branches/Amaury_dev/libf/dyn3d_common/iso_verif_dyn.f90

@@ -1 @@
-  function iso_verif_noNaN_nostop(x,err_msg)
-    IMPLICIT NONE
-    ! si x est NaN, on affiche message
-    ! d'erreur et return 1 si erreur
+function iso_verif_noNaN_nostop(x, err_msg)
+  IMPLICIT NONE
+  ! si x est NaN, on affiche message
+  ! d'erreur et return 1 si erreur
 
-    ! input:
-    REAL :: x
-    CHARACTER(LEN=*) :: err_msg ! message d''erreur à afficher
+  ! input:
+  REAL :: x
+  CHARACTER(LEN = *) :: err_msg ! message d''erreur à afficher
 
-    ! output
-    REAL :: borne
-    parameter (borne=1e19)
-    INTEGER :: iso_verif_noNaN_nostop
+  ! output
+  REAL :: borne
+  parameter (borne = 1e19)
+  INTEGER :: iso_verif_noNaN_nostop
 
-    IF ((x>-borne).AND.(x<borne)) THEN
-            iso_verif_noNAN_nostop=0
-    else
-        WRITE(*,*) 'erreur detectee par iso_verif_nonNaN:'
-        WRITE(*,*) err_msg
-        WRITE(*,*) 'x=',x
-        iso_verif_noNaN_nostop=1
-    endif
+  IF ((x>-borne).AND.(x<borne)) THEN
+    iso_verif_noNAN_nostop = 0
+  else
+    WRITE(*, *) 'erreur detectee par iso_verif_nonNaN:'
+    WRITE(*, *) err_msg
+    WRITE(*, *) 'x=', x
+    iso_verif_noNaN_nostop = 1
+  endif
 
-    RETURN
+  RETURN
 END FUNCTION iso_verif_nonan_nostop
 
-  function iso_verif_egalite_nostop &
-          (a,b,err_msg)
-    IMPLICIT NONE
-    ! compare a et b. Si pas egal, on affiche message
-    ! d'erreur et stoppe
-    ! pour egalite, on verifie erreur absolue et arreur relative
+function iso_verif_egalite_nostop &
+        (a, b, err_msg)
+  IMPLICIT NONE
+  ! compare a et b. Si pas egal, on affiche message
+  ! d'erreur et stoppe
+  ! pour egalite, on verifie erreur absolue et arreur relative
 
-    ! input:
-    REAL :: a, b
-    CHARACTER(LEN=*) :: err_msg ! message d''erreur à afficher
+  ! input:
+  REAL :: a, b
+  CHARACTER(LEN = *) :: err_msg ! message d''erreur à afficher
 
-    ! locals
-    REAL :: errmax ! erreur maximale en absolu.
-    REAL :: errmaxrel ! erreur maximale en relatif autorisée
-    parameter (errmax=1e-8)
-    parameter (errmaxrel=1e-3)
+  ! locals
+  REAL :: errmax ! erreur maximale en absolu.
+  REAL :: errmaxrel ! erreur maximale en relatif autorisée
+  parameter (errmax = 1e-8)
+  parameter (errmaxrel = 1e-3)
 
-    ! output
-    INTEGER :: iso_verif_egalite_nostop
+  ! output
+  INTEGER :: iso_verif_egalite_nostop
 
-    iso_verif_egalite_nostop=0
+  iso_verif_egalite_nostop = 0
 
-    IF (abs(a-b)>errmax) THEN
-      IF (abs((a-b)/max(max(abs(b),abs(a)),1e-18)) &
+  IF (abs(a - b)>errmax) THEN
+    IF (abs((a - b) / max(max(abs(b), abs(a)), 1e-18)) &
             >errmaxrel) THEN
-        WRITE(*,*) 'erreur detectee par iso_verif_egalite:'
-        WRITE(*,*) err_msg
-        WRITE(*,*) 'a=',a
-        WRITE(*,*) 'b=',b
-        iso_verif_egalite_nostop=1
-      endif
+      WRITE(*, *) 'erreur detectee par iso_verif_egalite:'
+      WRITE(*, *) err_msg
+      WRITE(*, *) 'a=', a
+      WRITE(*, *) 'b=', b
+      iso_verif_egalite_nostop = 1
     endif
+  endif
 
-    RETURN
+  RETURN
 END FUNCTION iso_verif_egalite_nostop
 
 
-  function iso_verif_aberrant_nostop &
-          (x,iso,q,err_msg)
-    USE lmdz_infotrac, ONLY: isoName, getKey
-    IMPLICIT NONE
+function iso_verif_aberrant_nostop &
+        (x, iso, q, err_msg)
+  USE lmdz_infotrac, ONLY: isoName, getKey
+  IMPLICIT NONE
 
-    ! input:
-    REAL :: x,q
-    INTEGER :: iso ! 2=HDO, 1=O18
-    CHARACTER(LEN=*) :: err_msg ! message d''erreur à afficher
+  ! input:
+  REAL :: x, q
+  INTEGER :: iso ! 2=HDO, 1=O18
+  CHARACTER(LEN = *) :: err_msg ! message d''erreur à afficher
 
-    ! locals
-    REAL :: qmin,deltaD
-    REAL :: deltaDmax,deltaDmin,tnat
-    parameter (qmin=1e-11)
-    parameter (deltaDmax=200.0,deltaDmin=-999.9)
+  ! locals
+  REAL :: qmin, deltaD
+  REAL :: deltaDmax, deltaDmin, tnat
+  parameter (qmin = 1e-11)
+  parameter (deltaDmax = 200.0, deltaDmin = -999.9)
+  LOGICAL, SAVE :: ltnat1
+  LOGICAL, SAVE :: lFirst = .TRUE.
 
-    ! output
-    INTEGER :: iso_verif_aberrant_nostop
+  ! output
+  INTEGER :: iso_verif_aberrant_nostop
 
-    iso_verif_aberrant_nostop=0
+  IF(lFirst) THEN
+    ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1)
+    lFirst = .FALSE.
+  END IF
+  iso_verif_aberrant_nostop = 0
 
-    ! verifier que HDO est raisonable
-     IF (q>qmin) THEN
-         IF(getKey('tnat', tnat, isoName(iso))) THEN
-              err_msg = 'Missing isotopic parameter "tnat"'
-              iso_verif_aberrant_nostop=1
-              RETURN
-         END IF
-         deltaD=(x/q/tnat-1)*1000
-         IF ((deltaD>deltaDmax).OR.(deltaD<deltaDmin)) THEN
-              WRITE(*,*) 'erreur detectee par iso_verif_aberrant:'
-              WRITE(*,*) err_msg
-              WRITE(*,*) 'q=',q
-              WRITE(*,*) 'deltaD=',deltaD
-              WRITE(*,*) 'iso=',iso
-              iso_verif_aberrant_nostop=1
-         endif !if ((deltaD.gt.deltaDmax).OR.(deltaD.lt.deltaDmin)) THEN
-      endif !if (q(i,k,iq).gt.qmin) THEN
-    RETURN
+  ! verifier que HDO est raisonable
+  IF (q>qmin) THEN
+    IF(ltnat1) THEN
+      tnat = 1.0
+    ELSE IF(getKey('tnat', tnat, isoName(iso))) THEN
+      err_msg = 'Missing isotopic parameter "tnat"'
+      iso_verif_aberrant_nostop = 1
+      RETURN
+    END IF
+    deltaD = (x / q / tnat - 1) * 1000
+    IF ((deltaD>deltaDmax).OR.(deltaD<deltaDmin)) THEN
+      WRITE(*, *) 'erreur detectee par iso_verif_aberrant:'
+      WRITE(*, *) err_msg
+      WRITE(*, *) 'q=', q
+      WRITE(*, *) 'deltaD=', deltaD
+      WRITE(*, *) 'iso=', iso
+      iso_verif_aberrant_nostop = 1
+    endif !if ((deltaD.gt.deltaDmax).OR.(deltaD.lt.deltaDmin)) THEN
+  endif !if (q(i,k,iq).gt.qmin) THEN
+  RETURN
 END FUNCTION iso_verif_aberrant_nostop