Changeset 4235 for dynamico_lmdz/simple_physics/phyparam/DYNAMICO/icosa_phyparam_mod.F90

Timestamp:

Jan 21, 2020, 12:54:37 AM (5 years ago)

Author:

dubos

Message:

simple_physics : DYNAMICO driver

File:

• dynamico_lmdz/simple_physics/phyparam/DYNAMICO/icosa_phyparam_mod.F90 (modified) (3 diffs)

dynamico_lmdz/simple_physics/phyparam/DYNAMICO/icosa_phyparam_mod.F90

@@ -1 +1 @@
 MODULE icosa_phyparam_mod
+#include "use_logging.h"
+
+! FCM gets confused when external modules are USEd at module level
+! => USE statements to DYNAMICO modules go into subroutines
+
   IMPLICIT NONE
+  PRIVATE
   SAVE
+
+  LOGICAL :: firstcall = .TRUE.
+  LOGICAL, PARAMETER :: lastcall = .FALSE.
+
+  REAL, PARAMETER :: oneday = 86400. ! hard-coded                                                                                                                                                         
+  INTEGER, PARAMETER :: log_unit = 15
+
+  PUBLIC :: init_physics, physics
 
   CONTAINS
@@ -7 +21 @@
     SUBROUTINE init_physics
       ! DYNAMICO
-      USE mpipara,   ONLY : is_mpi_master
-      USE icosa,     ONLY : llm, g, radius, cpp, kappa 
-      USE time_mod,  ONLY : dt, itau_physics
+      USE mpipara,  ONLY : is_mpi_master
+      USE icosa,    ONLY : llm
+
+      USE icosa,     ONLY : g, radius, cpp, kappa 
       USE getin_mod, ONLY : getin
-      USE physics_interface_mod
+      USE physics_interface_mod, ONLY : inout => physics_inout
       ! phyparam
+      USE logging, ONLY : flush_plugin, dbtag, max_log_level
+      USE read_param_mod
       USE comgeomfi
       USE iniphyparam_mod
       INTEGER, PARAMETER :: dayref=0
-      INTEGER :: ngrid
+      CHARACTER(10) :: physics_log_level
+      INTEGER :: ngrid, lev
+      REAL    :: timestep
       REAL    :: unjours ! solar day in seconds
 
-      IF(is_mpi_master) WRITE(*,*) 'phyparam/init_physics called'
-      
-      ngrid = physics_inout%ngrid
+      flush_plugin => flush_log_
+
+      physics_log_level='INF'
+      CALL getin('physics_log_level', physics_log_level)
+      DO lev=1, SIZE(dbtag)
+         IF(dbtag(lev)==TRIM(physics_log_level)) THEN
+            max_log_level = lev
+            EXIT
+         END IF
+      END DO
+
+      read_paramr_plugin => read_paramr
+      read_parami_plugin => read_parami
+      read_paramb_plugin => read_paramb
+
+      WRITELOG(*,*) 'init_physics called'
+      WRITELOG(*,*) 'physics log level set to ', dbtag(max_log_level)
+      LOG_INFO('phyparam')
+
+      ngrid = inout%ngrid
+      timestep = inout%dt_phys
+
       unjours = 86400.
       CALL getin('unjours', unjours)
 
-      CALL init_comgeomfi(ngrid, llm, &
-           &              physics_inout%lon, physics_inout%lat)
+      CALL init_comgeomfi(ngrid, llm, inout%lon, inout%lat)
       CALL iniphyparam(ngrid, llm,                &
-           &           unjours, dayref, dt*itau_physics, & 
+           &           unjours, dayref, timestep, & 
            &           radius, g, cpp*kappa, cpp)
 
@@ -34 +71 @@
 
     SUBROUTINE physics
-      USE mpipara, ONLY : is_mpi_master
-      IF(is_mpi_master) PRINT *, 'phyparam/physics called'
+      USE mpipara,  ONLY : is_mpi_master
+      USE icosa,    ONLY : llm
+      USE physics_interface_mod, ONLY : inout => physics_inout
+      USE phyparam_mod
+      USE error_mod
+      REAL :: dps(inout%ngrid), play(inout%ngrid, llm), pphi(inout%ngrid, llm)
+      REAL :: timestep, time, jourvrai, gmtime
+      INTEGER :: l
+      IF(is_mpi_master) WRITE(log_unit,*) 'phyparam/physics called', SHAPE(inout%p), SHAPE(inout%pk)      
+
+      timestep = inout%dt_phys
+      time = timestep * inout%it
+      gmtime = time/oneday
+      jourvrai = FLOOR(gmtime)
+      gmtime   = gmtime - jourvrai
+
+      ! compute pressure and geopotential at full levels
+      CALL compute_play(inout%ngrid, llm, inout%p, play)
+      CALL compute_play(inout%ngrid, llm, inout%geopot, pphi)
+
+      ! substract surface geopotential
+      DO l=1,llm
+         pphi(:,l) = pphi(:,l) - inout%geopot(:,1)
+      END DO
+
+      IF(is_mpi_master) PRINT *, 'phyparam phi :', pphi(inout%ngrid/2+1, :)
+
+      CALL check_NaN('physics', 'ulon', inout%ulon)
+      CALL check_NaN('physics', 'ulat', inout%ulat)
+      CALL check_NaN('physics', 'temp', inout%temp)
+
+      ! go
+      CALL phyparam(inout%ngrid,llm,                       &
+           &        firstcall,lastcall,                    &
+           &        jourvrai, gmtime, timestep,            &
+           &        inout%p, play, pphi,                   &
+           &        inout%ulon,  inout%ulat,  inout%temp,  &
+           &        inout%dulon, inout%dulat, inout%dtemp, dps)
+
+      IF(is_mpi_master) PRINT *, 'phyparam dT :', inout%dtemp(inout%ngrid/2+1, :)
+
+      CALL check_NaN('physics', 'dulon', inout%dulon)
+      CALL check_NaN('physics', 'dulat', inout%dulat)
+      CALL check_NaN('physics', 'dtemp', inout%dtemp)
+
+      firstcall = .FALSE.
     END SUBROUTINE physics
 
+    SUBROUTINE compute_play(ngrid, llm, plev, play)
+      INTEGER, INTENT(IN) :: ngrid, llm
+      REAL, INTENT(IN)    :: plev(ngrid, llm+1) ! pressure at interfaces (half-levels)
+      REAL, INTENT(OUT)   :: play(ngrid, llm)   ! pressure in layers (full levels)
+      INTEGER :: ij, l
+      DO l = 1,llm
+         DO ij = 1,ngrid
+            play(ij,l) = .5*(plev(ij,l)+plev(ij,l+1))
+         END DO
+      END DO
+    END SUBROUTINE compute_play
+
+!------------------------------------------------------------------------------------
+!------------------------------- Infrastructure plugins -----------------------------
+
+!--------------------------------------- Logging ------------------------------------
+
+    SUBROUTINE flush_log_(lev, tag, buf)
+      USE mpipara, ONLY : is_mpi_master
+      USE logging, ONLY : dbtag
+      INTEGER, INTENT(IN) :: lev
+      CHARACTER(*), INTENT(IN) :: tag, buf(:)
+      CHARACTER(100) :: prefix
+      INTEGER :: i
+
+      IF(is_mpi_master) THEN
+         WRITE(prefix,*) '[', dbtag(lev), ' ', tag, ']'
+         DO i=1, SIZE(buf)
+            WRITE(log_unit,*) TRIM(prefix), TRIM(buf(i))
+         END DO
+         WRITE(log_unit, *) ''
+      END IF
+    END SUBROUTINE flush_log_
+
+!--------------------------------------- read_param ------------------------------------
+
+    SUBROUTINE read_paramr(name, defval, val, comment)
+      USE getin_mod, ONLY : getin
+      CHARACTER(*), INTENT(IN) :: name, comment
+      REAL, INTENT(IN)         :: defval
+      REAL, INTENT(OUT)        :: val
+      val = defval
+      CALL getin(name, val)
+    END SUBROUTINE read_paramr
+
+    SUBROUTINE read_parami(name, defval, val, comment)
+      USE getin_mod, ONLY : getin
+      CHARACTER(*), INTENT(IN) :: name, comment
+      INTEGER, INTENT(IN)      :: defval
+      INTEGER, INTENT(OUT)     :: val
+      val = defval
+      CALL getin(name, val)
+    END SUBROUTINE read_parami
+    
+    SUBROUTINE read_paramb(name, defval, val, comment)
+      USE getin_mod, ONLY : getin
+      CHARACTER(*), INTENT(IN) :: name, comment
+      LOGICAL, INTENT(IN)      :: defval
+      LOGICAL, INTENT(OUT)     :: val
+      val = defval
+      CALL getin(name, val)
+    END SUBROUTINE read_paramb
+
 END MODULE icosa_phyparam_mod