source: dynamico_lmdz/simple_physics/phyparam/DYNAMICO/icosa_phyparam_mod.F90 @ 4240

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
  
  USE icosa, ONLY : t_field

  IMPLICIT NONE
  PRIVATE
  SAVE

  LOGICAL :: firstcall = .TRUE.
  LOGICAL, PARAMETER :: lastcall = .FALSE.

  REAL, PARAMETER :: oneday = 86400. ! hard-coded                                                                                                                                                         
  INTEGER, PARAMETER :: log_unit = 15

  TYPE(t_field),POINTER :: f_write2d(:), f_write_llm(:), f_write_llmp1(:)

  PUBLIC :: init_physics, physics

  CONTAINS

    SUBROUTINE init_physics
      ! DYNAMICO
      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, 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
      CHARACTER(10) :: physics_log_level
      INTEGER :: ngrid, lev
      REAL    :: timestep
      REAL    :: unjours ! solar day in seconds

      flush_plugin => flush_log_

      CALL init_plugin_writefield

      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, inout%lon, inout%lat)
      CALL iniphyparam(timestep, unjours, radius, g, cpp*kappa, cpp)

    END SUBROUTINE init_physics

    SUBROUTINE physics
      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, taglen, tag, buflen, bufsize, buf) BIND(C)
      USE mpipara, ONLY : is_mpi_master
      USE logging, ONLY : dbtag
      USE, INTRINSIC :: iso_c_binding, ONLY : c_char, c_null_char, c_int
      INTEGER(c_int), INTENT(IN), VALUE :: lev, taglen, buflen, bufsize
      CHARACTER(KIND=c_char), INTENT(IN) :: tag(taglen), buf(buflen, bufsize)

      CHARACTER(buflen+1) :: line
      CHARACTER(100) :: prefix
      INTEGER :: i
      
      IF(is_mpi_master) THEN
         WRITE(prefix,*) '[', dbtag(lev), ' ', tag, ']'
         DO i=1, bufsize
            WRITE(line,*) buf(:,i)
            WRITE(log_unit,*) TRIM(prefix) // TRIM(line)
         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

!--------------------------------------- writefield ------------------------------------

    SUBROUTINE init_plugin_writefield
      USE icosa, ONLY : t_field, field_t, type_real, allocate_field, llm
      USE writefield_mod, ONLY : writefield1_plugin, writefield2_plugin
      CALL allocate_field(f_write2d,     field_t, type_real,        name='phyparam_write2d')
      CALL allocate_field(f_write_llm,   field_t, type_real, llm,   name='phyparam_write_llm')
      CALL allocate_field(f_write_llmp1, field_t, type_real, llm+1, name='phyparam_write_llmp1')
      writefield1_plugin => plugin_writefield1
    END SUBROUTINE init_plugin_writefield

    SUBROUTINE plugin_writefield1(name,longname,unit, var)
      USE physics_interface_mod, ONLY : unpack_field, inout => physics_inout
      USE output_field_mod, ONLY : output_field
      CHARACTER(*), INTENT(IN) :: name, longname, unit
      REAL, INTENT(IN)         :: var(:)
      WRITELOG(*,*) TRIM(name), ' : ', TRIM(longname), MINVAL(var), MAXVAL(var), inout%it
      LOG_INFO('writefield1')
      CALL unpack_field(f_write2d, var)
      CALL output_field('phyparam_'//TRIM(name), f_write2d)
    END SUBROUTINE plugin_writefield1

    SUBROUTINE plugin_writefield2(name,longname,unit, var)
      CHARACTER(*), INTENT(IN) :: name, longname, unit
      REAL, INTENT(IN)         :: var(:,:)
    END SUBROUTINE plugin_writefield2

END MODULE icosa_phyparam_mod