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

Last change on this file was 4242, checked in by dubos, 4 years ago

simple_physics : output SW fluxes
File size: 8.4 KB
Line 
1MODULE icosa_phyparam_mod
2#include "use_logging.h"
3
4! FCM gets confused when external modules are USEd at module level
5! => USE statements to DYNAMICO modules go into subroutines
6 
7  USE icosa, ONLY : t_field
8
9  IMPLICIT NONE
10  PRIVATE
11  SAVE
12
13  LOGICAL :: firstcall = .TRUE.
14  LOGICAL, PARAMETER :: lastcall = .FALSE.
15
16  REAL, PARAMETER :: oneday = 86400. ! hard-coded                                                                                                                                                         
17  INTEGER, PARAMETER :: log_unit = 15
18
19  TYPE(t_field),POINTER :: f_write2d(:), f_write_llm(:), f_write_llmp1(:)
20
21  PUBLIC :: init_physics, physics
22
23  CONTAINS
24
25    SUBROUTINE init_physics
26      ! DYNAMICO
27      USE mpipara,  ONLY : is_mpi_master
28      USE icosa,    ONLY : llm
29
30      USE icosa,     ONLY : g, radius, cpp, kappa
31      USE getin_mod, ONLY : getin
32      USE physics_interface_mod, ONLY : inout => physics_inout
33      ! phyparam
34      USE logging, ONLY : flush_plugin, dbtag, max_log_level
35      USE read_param_mod
36      USE comgeomfi
37      USE iniphyparam_mod
38      INTEGER, PARAMETER :: dayref=0
39      CHARACTER(10) :: physics_log_level
40      INTEGER :: ngrid, lev
41      REAL    :: timestep
42      REAL    :: unjours ! solar day in seconds
43
44      flush_plugin => flush_log_
45
46      CALL init_plugin_writefield
47
48      physics_log_level='INF'
49      CALL getin('physics_log_level', physics_log_level)
50      DO lev=1, SIZE(dbtag)
51         IF(dbtag(lev)==TRIM(physics_log_level)) THEN
52            max_log_level = lev
53            EXIT
54         END IF
55      END DO
56
57      read_paramr_plugin => read_paramr
58      read_parami_plugin => read_parami
59      read_paramb_plugin => read_paramb
60
61      WRITELOG(*,*) 'init_physics called'
62      WRITELOG(*,*) 'physics log level set to ', dbtag(max_log_level)
63      LOG_INFO('phyparam')
64
65      ngrid = inout%ngrid
66      timestep = inout%dt_phys
67
68      unjours = 86400.
69      CALL getin('unjours', unjours)
70
71      CALL init_comgeomfi(ngrid, llm, inout%lon, inout%lat)
72      CALL iniphyparam(timestep, unjours, radius, g, cpp*kappa, cpp)
73
74    END SUBROUTINE init_physics
75
76    SUBROUTINE physics
77      USE mpipara,  ONLY : is_mpi_master
78      USE icosa,    ONLY : llm
79      USE physics_interface_mod, ONLY : inout => physics_inout
80      USE phyparam_mod
81      USE error_mod
82      REAL :: dps(inout%ngrid), play(inout%ngrid, llm), pphi(inout%ngrid, llm)
83      REAL :: timestep, time, jourvrai, gmtime
84      INTEGER :: l
85      IF(is_mpi_master) WRITE(log_unit,*) 'phyparam/physics called', SHAPE(inout%p), SHAPE(inout%pk)     
86
87      timestep = inout%dt_phys
88      time = timestep * inout%it
89      gmtime = time/oneday
90      jourvrai = FLOOR(gmtime)
91      gmtime   = gmtime - jourvrai
92
93      ! compute pressure and geopotential at full levels
94      CALL compute_play(inout%ngrid, llm, inout%p, play)
95      CALL compute_play(inout%ngrid, llm, inout%geopot, pphi)
96
97      ! substract surface geopotential
98      DO l=1,llm
99         pphi(:,l) = pphi(:,l) - inout%geopot(:,1)
100      END DO
101
102!      IF(is_mpi_master) PRINT *, 'phyparam phi :', pphi(inout%ngrid/2+1, :)
103
104      CALL check_NaN('physics', 'ulon', inout%ulon)
105      CALL check_NaN('physics', 'ulat', inout%ulat)
106      CALL check_NaN('physics', 'temp', inout%temp)
107
108      ! go
109      CALL phyparam(inout%ngrid,llm,                       &
110           &        firstcall,lastcall,                    &
111           &        jourvrai, gmtime, timestep,            &
112           &        inout%p, play, pphi,                   &
113           &        inout%ulon,  inout%ulat,  inout%temp,  &
114           &        inout%dulon, inout%dulat, inout%dtemp, dps)
115
116!      IF(is_mpi_master) PRINT *, 'phyparam dT :', inout%dtemp(inout%ngrid/2+1, :)
117
118      CALL check_NaN('physics', 'dulon', inout%dulon)
119      CALL check_NaN('physics', 'dulat', inout%dulat)
120      CALL check_NaN('physics', 'dtemp', inout%dtemp)
121
122      firstcall = .FALSE.
123    END SUBROUTINE physics
124
125    SUBROUTINE compute_play(ngrid, llm, plev, play)
126      INTEGER, INTENT(IN) :: ngrid, llm
127      REAL, INTENT(IN)    :: plev(ngrid, llm+1) ! pressure at interfaces (half-levels)
128      REAL, INTENT(OUT)   :: play(ngrid, llm)   ! pressure in layers (full levels)
129      INTEGER :: ij, l
130      DO l = 1,llm
131         DO ij = 1,ngrid
132            play(ij,l) = .5*(plev(ij,l)+plev(ij,l+1))
133         END DO
134      END DO
135    END SUBROUTINE compute_play
136
137!------------------------------------------------------------------------------------
138!------------------------------- Infrastructure plugins -----------------------------
139
140!--------------------------------------- Logging ------------------------------------
141
142    SUBROUTINE flush_log_(lev, taglen, tag, buflen, bufsize, buf) BIND(C)
143      USE mpipara, ONLY : is_mpi_master
144      USE logging, ONLY : dbtag
145      USE, INTRINSIC :: iso_c_binding, ONLY : c_char, c_null_char, c_int
146      INTEGER(c_int), INTENT(IN), VALUE :: lev, taglen, buflen, bufsize
147      CHARACTER(KIND=c_char), INTENT(IN) :: tag(taglen), buf(buflen, bufsize)
148
149      CHARACTER(buflen+1) :: line
150      CHARACTER(100) :: prefix
151      INTEGER :: i
152     
153      IF(is_mpi_master) THEN
154         WRITE(prefix,*) '[', dbtag(lev), ' ', tag, ']'
155         DO i=1, bufsize
156            WRITE(line,*) buf(:,i)
157            WRITE(log_unit,*) TRIM(prefix) // TRIM(line)
158         END DO
159         WRITE(log_unit, *) ''
160      END IF
161    END SUBROUTINE flush_log_
162
163!--------------------------------------- read_param ------------------------------------
164
165    SUBROUTINE read_paramr(name, defval, val, comment)
166      USE getin_mod, ONLY : getin
167      CHARACTER(*), INTENT(IN) :: name, comment
168      REAL, INTENT(IN)         :: defval
169      REAL, INTENT(OUT)        :: val
170      val = defval
171      CALL getin(name, val)
172    END SUBROUTINE read_paramr
173
174    SUBROUTINE read_parami(name, defval, val, comment)
175      USE getin_mod, ONLY : getin
176      CHARACTER(*), INTENT(IN) :: name, comment
177      INTEGER, INTENT(IN)      :: defval
178      INTEGER, INTENT(OUT)     :: val
179      val = defval
180      CALL getin(name, val)
181    END SUBROUTINE read_parami
182   
183    SUBROUTINE read_paramb(name, defval, val, comment)
184      USE getin_mod, ONLY : getin
185      CHARACTER(*), INTENT(IN) :: name, comment
186      LOGICAL, INTENT(IN)      :: defval
187      LOGICAL, INTENT(OUT)     :: val
188      val = defval
189      CALL getin(name, val)
190    END SUBROUTINE read_paramb
191
192!--------------------------------------- writefield ------------------------------------
193
194    SUBROUTINE init_plugin_writefield
195      USE icosa, ONLY : t_field, field_t, type_real, allocate_field, llm
196      USE writefield_mod, ONLY : writefield1_plugin, writefield2_plugin
197      CALL allocate_field(f_write2d,     field_t, type_real,        name='phyparam_write2d')
198      CALL allocate_field(f_write_llm,   field_t, type_real, llm,   name='phyparam_write_llm')
199      CALL allocate_field(f_write_llmp1, field_t, type_real, llm+1, name='phyparam_write_llmp1')
200      writefield1_plugin => plugin_writefield1
201      writefield2_plugin => plugin_writefield2
202    END SUBROUTINE init_plugin_writefield
203
204    SUBROUTINE plugin_writefield1(name,longname,unit, var)
205      USE physics_interface_mod, ONLY : unpack_field, inout => physics_inout
206      USE output_field_mod, ONLY : output_field
207      CHARACTER(*), INTENT(IN) :: name, longname, unit
208      REAL, INTENT(IN)         :: var(:)
209      WRITELOG(*,*) TRIM(name), ' : ', TRIM(longname), SHAPE(var), inout%it
210      WRITELOG(*,*) TRIM(name), ' : ', MINVAL(var), MAXVAL(var)
211      LOG_INFO('writefield1')
212      CALL unpack_field(f_write2d, var)
213      CALL output_field('phyparam_'//TRIM(name), f_write2d)
214    END SUBROUTINE plugin_writefield1
215
216    SUBROUTINE plugin_writefield2(name,longname,unit, var)
217      USE physics_interface_mod, ONLY : unpack_field, inout => physics_inout
218      USE output_field_mod, ONLY : output_field
219      USE icosa,    ONLY : llm
220      CHARACTER(*), INTENT(IN) :: name, longname, unit
221      REAL, INTENT(IN)         :: var(:,:)
222      INTEGER :: nlev
223      WRITELOG(*,*) TRIM(name), ' : ', TRIM(longname), SHAPE(var), inout%it
224      WRITELOG(*,*) TRIM(name), ' : ', MINVAL(var), MAXVAL(var)
225      LOG_INFO('writefield2')
226      nlev = SIZE(var, 2)
227      IF(nlev==llm) THEN
228         CALL unpack_field(f_write_llm, var)
229         CALL output_field('phyparam_'//TRIM(name), f_write_llm)
230      ELSEIF(nlev==llm+1) THEN
231         CALL unpack_field(f_write_llmp1, var)
232         CALL output_field('phyparam_'//TRIM(name), f_write_llmp1)
233      END IF
234    END SUBROUTINE plugin_writefield2
235
236END MODULE icosa_phyparam_mod
Note: See TracBrowser for help on using the repository browser.