Changeset 4235 for dynamico_lmdz/simple_physics/phyparam

Timestamp:

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

Author:

dubos

Message:

simple_physics : DYNAMICO driver

Location:

dynamico_lmdz/simple_physics/phyparam

Files:

• DYNAMICO/icosa_phyparam_mod.F90 (modified) (3 diffs)
• Makefile (modified) (3 diffs)
• physics/callkeys.F90 (modified) (1 diff)
• physics/error_mod.F90 (added)
• physics/iniphyparam_mod.F90 (modified) (1 diff)
• physics/logging.F90 (modified) (2 diffs)
• physics/read_param_mod.F90 (modified) (2 diffs)
• physics/writefield_mod.F90 (modified) (1 diff)

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

dynamico_lmdz/simple_physics/phyparam/Makefile

@@ -11 +11 @@
 F90FLAGS ?= -ffree-line-length-none
 
-VPATH = obj
 NAMES = $(basename $(notdir $(wildcard physics/*.F90)))
 OBJECTS = $(addprefix obj/, $(addsuffix .o, $(NAMES)))
@@ -18 +17 @@
 
 obj :
+        @rm -rf obj include lib xml tmp *~ */*~
         @mkdir obj include lib xml tmp
 
-deps : 
+clean :
+        @rm -rf obj include lib xml tmp *~ */*~
+        @mkdir obj include lib xml tmp
         @../bash/concatenate_all_code.sh $(NAMES) > tmp/all_code
         @../bash/makedeps.sh tmp/all_code >  Makefile.inc
-
-clean : deps
-        rm -rf obj include lib xml tmp *~ */*~
 
 nice:
@@ -41 +40 @@
         @$(FFRONT) -M tmp tmp/$(SRC).f90 > xml/$(SRC).xml
 
+# dependencies between modules
+
+$(OBJECTS) : obj/logging.o
 -include Makefile.inc

dynamico_lmdz/simple_physics/phyparam/physics/callkeys.F90

@@ -3 +3 @@
   SAVE
 
-  LOGICAL callrad,calldifv,calladj,callcond,callsoil,season,diurnal,lverbose
-  INTEGER iradia
-  REAL period_sort
+  LOGICAL ::  callrad, calldifv, calladj, callsoil, season, diurnal, lverbose
+  INTEGER :: iradia
+  REAL :: period_sort
 
 END MODULE callkeys

dynamico_lmdz/simple_physics/phyparam/physics/iniphyparam_mod.F90

@@ -54 +54 @@
     CALL read_param('coefir',.08      ,coefir,'coefir')
 
-    CALL read_param('callrad',.true.,callrad,'appel rayonnemen')
+    CALL read_param('callrad',.true.,callrad,'appel rayonnement')
     CALL read_param('calldifv',.true.,calldifv,'appel difv')
     CALL read_param('calladj',.true.,calladj,'appel adj')
-    CALL read_param('callcond',.true.,callcond,'appel cond')
     CALL read_param('callsoil',.true.,callsoil,'appel soil')
-    CALL read_param('season',.true.,season,'appel soil')
-    CALL read_param('diurnal',.false.,diurnal,'appel soil')
-    CALL read_param('lverbose',.true.,lverbose,'appel soil')
+    CALL read_param('season',.true.,season,'with seasonal cycle')
+    CALL read_param('diurnal',.false.,diurnal,'with diurnal cycle')
+    CALL read_param('lverbose',.true.,lverbose,'lverbose')
     CALL read_param('period_sort',1.,period_sort,'period sorties en jour')
 

dynamico_lmdz/simple_physics/phyparam/physics/logging.F90

@@ -42 +42 @@
   INTEGER, PARAMETER, PUBLIC :: log_level_fatal=1, log_level_error=2, log_level_warn=3, log_level_info=4, log_level_dbg=5
   INTEGER, PUBLIC :: max_log_level = log_level_info
+  CHARACTER(3), DIMENSION(log_level_dbg), PUBLIC :: dbtag = (/ 'FAT', 'ERR', 'WRN', 'INF', 'DBG' /)
 
   PUBLIC :: logging_buf, logging_bufsize, logging_lineno, flush_log, log_gridpoint, &
@@ -73 +74 @@
     INTEGER, INTENT(IN) :: lev
     CHARACTER(*), INTENT(IN) :: tag, buf(:)
-    CHARACTER(3), DIMENSION(log_level_dbg) :: dbtag = (/ 'FAT', 'ERR', 'WRN', 'INF', 'DBG' /)
     CHARACTER(100) :: prefix
     INTEGER :: i

dynamico_lmdz/simple_physics/phyparam/physics/read_param_mod.F90

@@ -43 +43 @@
   INTERFACE read_param
      PROCEDURE read_paramr, read_parami, read_paramb
-  END INTERFACE
+  END INTERFACE read_param
 
   PUBLIC :: read_param
@@ -86 +86 @@
     LOGICAL, INTENT(OUT)     :: val
 #ifndef XCODEML
-    IF(.NOT.ASSOCIATED(read_paramr_plugin)) THEN
+    IF(.NOT.ASSOCIATED(read_paramb_plugin)) THEN
        CALL missing_plugin('read_paramb','read_param_mod')
        val = defval

dynamico_lmdz/simple_physics/phyparam/physics/writefield_mod.F90

@@ -24 +24 @@
   INTERFACE writefield
      PROCEDURE writefield1, writefield2
-  END INTERFACE
+  END INTERFACE writefield
 
   PUBLIC :: writefield