source: trunk/WRF.COMMON/INTERFACES_V4/dynphy_wrf_titan_lmd/update_inputs_physiq_mod.F

Last change on this file was 3661, checked in by emoisan, 10 months ago

Titan CRM:
Add Titan interface in INTERFACES_V4
Adapt module_model_constants.F to Titan
Add new tracer_mode for Titan (CH4 scalar)
Add new communication of variables between LMDZ.TITAN and WRF
Allow microphysics for Mesoscale in physiq_mod.F90
EMo
File size: 19.0 KB
Line 
1MODULE update_inputs_physiq_mod
2
3CONTAINS
4
5!SUBROUTINE update_inputs_physiq_time
6!SUBROUTINE update_inputs_physiq_tracers
7!SUBROUTINE update_inputs_physiq_constants
8!SUBROUTINE update_inputs_physiq_geom
9!SUBROUTINE update_inputs_physiq_surf
10!SUBROUTINE update_inputs_physiq_soil
11!SUBROUTINE update_inputs_physiq_turb
12!SUBROUTINE update_inputs_physiq_rad
13!SUBROUTINE update_inputs_physiq_slope
14
15!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
17SUBROUTINE update_inputs_physiq_time(&
18            JULYR,JULDAY,GMT,&
19            elaps,&
20            lct_input,lon_input,ls_input,&
21            MY)
22  USE variables_mod, only: JD_cur,JH_cur_split,phour_ini
23  use callkeys_mod, only : tlocked
24  INTEGER, INTENT(IN) :: JULDAY, JULYR
25  REAL, INTENT(IN) :: GMT,elaps,lon_input,ls_input,lct_input
26  REAL,INTENT(OUT) :: MY
27  REAL :: sec,nsec
28  !IF (JULYR .le. 8999) THEN
29    if (tlocked .eqv. .false.) THEN
30      JH_cur_split = (GMT + elaps/3600.) !! universal time (0<JH_cur_split<1): JH_cur_split=0.5 at 12:00 UT
31      JH_cur_split = MODULO(JH_cur_split,24.)   !! the two arguments of MODULO must be of the same type
32      JH_cur_split = JH_cur_split / 24.
33      JD_cur = (JULDAY - 1 + INT((3600.0*GMT+elaps)/86400))
34      JD_cur = MODULO(int(JD_cur),2)
35      MY = (JULYR-2000) + (86400*(JULDAY - 1)+3600.0*GMT+elaps)/31968000
36      MY = INT(MY)
37  !  ELSE
38  !    JH_cur_split = (GMT)! + elaps/420000.) !! universal time (0<JH_cur_split<1): JH_cur_split=0.5 at 12:00 UT
39  !    JH_cur_split = MODULO(JH_cur_split,24.)   !! the two arguments of MODULO must be of the same type
40  !    JH_cur_split = JH_cur_split / 24.
41  !    JD_cur = (JULDAY - 1 + INT((3600*GMT)/86400))!+elaps)/1.008e7))
42  !    JD_cur = MODULO(int(JD_cur),2)
43  !    MY = (JULYR-2000) + (86400*(JULDAY - 1)+3600*GMT+elaps)/31968000
44  !    MY = INT(MY)
45  !  ENDIF
46  !ELSE
47  !  if (tlocked .eqv. .false.) THEN
48  !    JH_cur_split = lct_input - lon_input / 15. + elaps/1500.0
49  !    JD_cur =  INT((sec*(lct_input - lon_input / 15.) + elaps)/36000)
50  !    !ptime = lct_input - lon_input / 15. + elaps/3600.
51  !    !pday =  INT((3600*(lct_input - lon_input / 15.) + elaps)/86400)
52  ELSE
53       JH_cur_split = 0.
54       JD_cur = 0.
55  !    !pday =  INT((sec*(lct_input - lon_input / 15.)+ elaps)/36000)
56  !    JD_cur =  INT((sec*(lct_input - lon_input / 15.))/3600)
57  !    !print*,'ptime',ptime
58  !    !print*,'pday',pday
59  !  !pday =  INT((3600*(lct_input - lon_input / 15.) + elaps)/86400)
60  !    JH_cur_split = MODULO(ptime,24.)
61  !    JH_cur_split = JH_cur_split / 24.
62  !    JD_cur = MODULO(int(pday),365)
63  !    MY = 2024
64  !  ENDIF
65  ENDIF
66
67
68END SUBROUTINE update_inputs_physiq_time
69
70!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
71!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
72SUBROUTINE update_inputs_physiq_tracers(TRACER_MODE,nq)
73
74  use tracer_h, only: noms,nqtot_p
75  INTEGER, INTENT(IN) :: TRACER_MODE
76  INTEGER, INTENT(OUT) :: nq
77  INTEGER :: i,k
78  logical :: end_of_file
79
80  !! TRACERS
81     
82                 !! tableau dans tracer_mod.F90
83  if ((TRACER_MODE .eq. 1) .or. ((TRACER_MODE .ge. 42) .and. (TRACER_MODE .le. 45))) THEN
84    nqtot_p=2
85    IF (.not.ALLOCATED(noms)) ALLOCATE(noms(nqtot_p)) !! est fait dans initracer normalement
86    noms(1)="h2o_vap"
87    noms(2)="h2o_ice"
88  else if (TRACER_MODE .eq. 61) THEN
89    nqtot_p=8
90    IF (.not.ALLOCATED(noms)) ALLOCATE(noms(nqtot_p)) !! est fait dans initracer normalement
91    noms(1)="mu_m0as"
92    noms(2)="mu_m3as"
93    noms(3)="mu_m0af"
94    noms(4)="mu_m3af"
95    noms(5)="mu_m0n"
96    noms(6)="mu_m3n"
97    noms(7)="mu_m3CH4"
98    noms(8)="CH4"
99  else
100    nq=1 ! why not nqtot_p?
101    IF (.not.ALLOCATED(noms)) ALLOCATE(noms(nqtot_p)) !! est fait dans initracer normalement
102    noms(:)="zolbxs"
103  endif
104  nq=nqtot_p
105
106END SUBROUTINE update_inputs_physiq_tracers
107
108!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
109!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
110SUBROUTINE update_inputs_physiq_constants
111
112   use planete_mod, only: year_day, periastr, apoastr, peri_day,&
113                       obliquit, z0, lmixmin, emin_turb
114   use surfdat_h,  only: emissiv,iceradius, &
115                         emisice,dtemisice
116   !                       z0_default
117   use comcstfi_mod, only: rad, omeg, g, mugaz, rcp, cpp, r
118!  use phys_state_var_mod, only :cloudfrac,totcloudfrac,hice,rnat,pctsrf_sic,tsea_ice
119   !JL22 this routine does not do anything for the generic interface
120   ! The various use abave can surely be removed.
121END SUBROUTINE update_inputs_physiq_constants
122
123!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
124!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
125SUBROUTINE update_inputs_physiq_geom( &
126            ims,ime,jms,jme,&
127            ips,ipe,jps,jpe,&
128            JULYR,ngrid,nlayer,&
129            DX,DY,MSFT,&
130            lat_input, lon_input,&
131            XLAT,XLONG)
132
133   ! in WRF (share)
134   USE module_model_constants, only: DEGRAD,p0
135   ! in LMD (phymars)
136   !use comgeomfi_h, only: ini_fillgeom
137   ! in LMD (phy_common)
138   USE mod_grid_phy_lmdz, ONLY: init_grid_phy_lmdz
139   USE geometry_mod, ONLY: latitude,latitude_deg,&
140                           longitude,longitude_deg,&
141                           cell_area
142   use comdiurn_h, only: sinlat, coslat, sinlon, coslon
143   !use planetwide_mod, only: planetwide_sumval
144   use comgeomfi_h, only: totarea, totarea_planet
145   use planete_mod, only: ini_planete_mod
146
147   INTEGER, INTENT(IN) :: ims,ime,jms,jme
148   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,ngrid,nlayer
149   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
150     MSFT,XLAT,XLONG
151   REAL, INTENT(IN) :: dx,dy
152   REAL, INTENT(IN) :: lat_input, lon_input
153   INTEGER :: i,j,subs,ig,k
154   REAL,DIMENSION(ngrid) :: plon, plat, parea
155   REAL, DIMENSION(nlayer+1) :: znw
156   REAL*8, DIMENSION(nlayer+1) :: apdyn,bpdyn
157   REAL :: ptop
158   REAL*8 :: PP0
159   DO j = jps,jpe
160   DO i = ips,ipe
161
162    !-----------------------------------!
163    ! 1D subscript for physics "cursor" !
164    !-----------------------------------!
165    subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
166
167    !----------------------------------------!
168    ! Surface of each part of the grid (m^2) ! 
169    !----------------------------------------!
170    !parea(subs) = dx*dy                           !! 1. idealized cases - computational grid
171    parea(subs) = (dx/msft(i,j))*(dy/msft(i,j))    !! 2. WRF map scale factors - assume that msfx=msfy (msf=covariance)
172    !parea(subs)=dx*dy/msfu(i,j)                   !! 3. special for Mercator GCM-like simulations
173
174    !---------------------------------------------!
175    ! Mass-point latitude and longitude (radians) !
176    !---------------------------------------------!
177    IF (JULYR .le. 8999) THEN
178     plat(subs) = XLAT(i,j)*DEGRAD
179     plon(subs) = XLONG(i,j)*DEGRAD
180    ELSE
181     !!! IDEALIZED CASE
182     IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION lat: ',lat_input
183     IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION lon: ',lon_input
184     plat(subs) = lat_input*DEGRAD
185     plon(subs) = lon_input*DEGRAD
186    ENDIF
187
188   ENDDO
189   ENDDO
190
191   !! FILL GEOMETRICAL ARRAYS !!
192   !call ini_fillgeom(ngrid,plat,plon,parea)
193
194   !!! ----------------------------------------------------------
195   !!! --- initializing geometry in phy_common
196   !!! --- (this is quite planet-independent)
197   !!! ----------------------------------------------------------
198   ! initialize mod_grid_phy_lmdz
199   CALL init_grid_phy_lmdz(1,1,ipe-ips+1,jpe-jps+1,nlayer)
200   ! fill in geometry_mod variables
201   ! ... copy over local grid longitudes and latitudes
202   ! ... partly what is done in init_geometry
203   IF(.not.ALLOCATED(longitude)) ALLOCATE(longitude(ngrid))
204   IF(.not.ALLOCATED(longitude_deg)) ALLOCATE(longitude_deg(ngrid))
205   IF(.not.ALLOCATED(latitude)) ALLOCATE(latitude(ngrid))
206   IF(.not.ALLOCATED(latitude_deg)) ALLOCATE(latitude_deg(ngrid))
207   IF(.not.ALLOCATED(cell_area)) ALLOCATE(cell_area(ngrid))
208   longitude(:) = plon(:)
209   latitude(:) = plat(:)
210   longitude_deg(:) = plon(:)/DEGRAD
211   latitude_deg(:) = plat(:)/DEGRAD
212   cell_area(:) = parea(:)
213   totarea=ngrid*parea(1)
214   totarea_planet=ngrid*parea(1)
215
216   IF (.not.ALLOCATED(sinlat)) ALLOCATE(sinlat(ngrid))
217   IF (.not.ALLOCATED(coslat)) ALLOCATE(coslat(ngrid))
218   IF (.not.ALLOCATED(sinlon)) ALLOCATE(sinlon(ngrid))
219   IF (.not.ALLOCATED(coslon)) ALLOCATE(coslon(ngrid))
220   DO ig=1,ngrid
221     sinlat(ig)=sin(plat(ig))
222     coslat(ig)=cos(plat(ig))
223     sinlon(ig)=sin(plon(ig))
224     coslon(ig)=cos(plon(ig))
225   ENDDO
226   
227   open(unit=12,file='levels',form='formatted',status='old')
228   rewind(12)
229   DO k=1, nlayer
230   read(12,*) znw(k)
231   ENDDO
232   close(12)
233   
234   !! JL21 what is below is really weird. znw should be (p-ptop)/(ps-ptop).
235   !! and ap and bp should be used as p=ap+ps*bp.
236   !! this works only if ptop is actually equal to ptop in wrf. This is not the case.
237   !! however the pressure in physiqu seems to be ok !!!!!!!!!!! So why are we doing that
238
239   ptop=0.5
240   apdyn=ptop*(1-znw)
241   bpdyn=znw
242   PP0=p0
243   CALL ini_planete_mod(nlayer,PP0,apdyn,bpdyn)
244   !!! ----------------------------------------------------------
245
246END SUBROUTINE update_inputs_physiq_geom
247
248!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
249!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
250SUBROUTINE update_inputs_physiq_surf( &
251            ims,ime,jms,jme,&
252            ips,ipe,jps,jpe,&
253            JULYR,TRACER_MODE,&
254            P_ALBEDO,CST_AL,&
255            P_TSURF,P_EMISS,P_CO2ICE,&
256            P_GW,P_Z0,CST_Z0,&
257            P_H2OICE,&
258            phisfi_val)
259
260   use surfdat_h, only: phisfi, albedodat,  &
261                       zmea, zstd, zsig, zgam, zthe
262   use planete_mod, only: z0
263   use phys_state_var_mod, only : tsurf, emis, qsurf !,tslab
264
265   INTEGER, INTENT(IN) :: ims,ime,jms,jme
266   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,TRACER_MODE
267   INTEGER :: i,j,subs,nlast,iq
268   REAL, INTENT(IN  ) :: CST_AL, phisfi_val, CST_Z0
269   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
270     P_ALBEDO,P_TSURF,P_EMISS,P_CO2ICE,P_H2OICE,P_Z0
271   REAL, DIMENSION( ims:ime, 5, jms:jme ), INTENT(IN   )  :: P_GW 
272
273   DO j = jps,jpe
274   DO i = ips,ipe
275
276     !-----------------------------------!
277     ! 1D subscript for physics "cursor" !
278     !-----------------------------------!
279     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
280
281     !---------------------!
282     ! Ground geopotential !
283     !---------------------!
284     phisfi(subs) = phisfi_val
285     !---------------!
286     ! Ground albedo !
287     !---------------!
288     IF (JULYR .le. 8999) THEN
289      IF (CST_AL == 0) THEN
290       albedodat(subs)=P_ALBEDO(i,j)
291      ELSE
292       albedodat(subs)=CST_AL
293       IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** SET CONSTANT ALBEDO ', albedodat
294      ENDIF
295     ELSE
296      IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION albedo: ', CST_AL
297      albedodat(subs)=CST_AL
298     ENDIF
299
300     !-----------------------------------------!
301     ! Gravity wave parametrization            !
302     ! NB: usually 0 in mesoscale applications !
303     !-----------------------------------------!
304     zmea(subs)=0.
305     zstd(subs)=0.
306     zsig(subs)=0.
307     zgam(subs)=0.
308     zthe(subs)=0.
309
310     !----------------------------!
311     ! Variable surface roughness !
312     !----------------------------!
313     z0 = CST_Z0
314     
315     !-----------------------------------------------!
316     ! Ground temperature, emissivity, CO2 ice cover !
317     !-----------------------------------------------!
318     tsurf(subs) = P_TSURF(i,j)
319     emis(subs) = P_EMISS(i,j)     
320     !do i=1,noceanmx
321!    tslab(subs,:)=tsurf(subs)
322     !enddo
323     !-------------------!
324     ! Tracer at surface !
325     !-------------------!
326     qsurf(subs,:)=0. ! default case
327     SELECT CASE (TRACER_MODE)
328       CASE(1)
329         qsurf(subs,2)=P_H2OICE(i,j)  !! logique avec noms(2) = 'h2o_ice' defini ci-dessus
330                                      !! ----- retrocompatible ancienne physique
331                                      !! ----- [H2O ice is last tracer in qsurf in LMD physics]
332     END SELECT
333
334   ENDDO
335   ENDDO
336 
337   !!---------------------!!
338   !! OUTPUT FOR CHECKING !!
339   !!---------------------!!
340   nlast = (ipe-ips+1)*(jpe-jps+1)
341   print*,"check: phisfi",phisfi(1),phisfi(nlast)
342   print*,"check: albedodat",albedodat(1),albedodat(nlast)
343   print*,"check: zmea",zmea(1),zmea(nlast)
344   print*,"check: zstd",zstd(1),zstd(nlast)
345   print*,"check: zsig",zsig(1),zsig(nlast)
346   print*,"check: zgam",zgam(1),zgam(nlast)
347   print*,"check: zthe",zthe(1),zthe(nlast)
348   print*,"check: z0",z0
349   print*,"check: tsurf",tsurf(1),tsurf(nlast)
350   print*,"check: emis",emis(1),emis(nlast)
351   print*,"check: qsurf",qsurf(1,:),qsurf(nlast,:)
352
353END SUBROUTINE update_inputs_physiq_surf
354
355!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
356!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
357SUBROUTINE update_inputs_physiq_soil( &
358            ims,ime,jms,jme,&
359            ips,ipe,jps,jpe,&
360            JULYR,nsoil,&
361            P_TI,CST_TI,&
362            P_ISOIL,P_DSOIL,&
363            P_TSOIL,P_TSURF)
364
365   use comsoil_h, only: inertiedat,mlayer,layer,volcapa
366   use phys_state_var_mod, only: tsoil
367
368   INTEGER, INTENT(IN) :: ims,ime,jms,jme
369   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR,nsoil
370   INTEGER :: i,j,subs,nlast
371   REAL, INTENT(IN  ) :: CST_TI
372   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: &
373     P_TI, P_TSURF
374   REAL, DIMENSION( ims:ime, nsoil, jms:jme ), INTENT(IN)  :: &
375     P_TSOIL, P_ISOIL, P_DSOIL
376   REAL :: inertiedat_val
377   REAL :: lay1,alpha
378
379   DO j = jps,jpe
380   DO i = ips,ipe
381
382     !-----------------------------------!
383     ! 1D subscript for physics "cursor" !
384     !-----------------------------------!
385     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
386
387     !-----------------!
388     ! Thermal Inertia !
389     !-----------------!
390     IF (JULYR .le. 8999) THEN
391      IF (CST_TI == 0) THEN
392       inertiedat_val=P_TI(i,j)
393      ELSE
394       inertiedat_val=CST_TI
395       IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** SET CONSTANT THERMAL INERTIA ', inertiedat_val
396      ENDIF
397     ELSE
398      IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION inertia: ',CST_TI
399      inertiedat_val=CST_TI
400     ENDIF
401     !inertiedat(subs) = inertiedat_val
402     !--pb de dimensions???!!???
403     IF (JULYR .le. 8999) THEN
404       inertiedat(subs,:)=P_ISOIL(i,:,j) !! verifier que cest bien hires TI en surface
405       mlayer(0:nsoil-1)=P_DSOIL(i,:,j)
406     ELSE
407        IF ( nsoil .lt. 18 ) THEN
408            PRINT *,'** Mars ** WRONG NUMBER OF SOIL LAYERS. SHOULD BE 18 AND IT IS ',nsoil
409        ENDIF
410        IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** IDEALIZED SIMULATION isoil and dsoil standard'
411        do k=1,nsoil
412         inertiedat(subs,k) = inertiedat_val
413         !mlayer(k-1) = sqrt(887.75/3.14)*((2.**(k-0.5))-1.) * inertiedat_val / wvolcapa    ! old setting
414         mlayer(k-1) = 2.E-4 * (2.**(k-0.5-1.))                                            ! new gcm settings
415        enddo
416     ENDIF
417     IF ( (i == ips) .AND. (j == jps) ) &
418         PRINT *,'** Mars ** TI and depth profiles are',inertiedat(subs,:)!,mlayer(0:nsoil-1)
419
420     !!!!!!!!!!!!!!!!! DONE in soil_setting.F
421     ! 1.5 Build layer(); following the same law as mlayer()
422     ! Assuming layer distribution follows mid-layer law:
423     ! layer(k)=lay1*alpha**(k-1)
424     lay1=sqrt(mlayer(0)*mlayer(1))
425     alpha=mlayer(1)/mlayer(0)
426     do k=1,nsoil
427       layer(k)=lay1*(alpha**(k-1))
428     enddo
429
430     !------------------------!
431     ! Deep soil temperatures !
432     !------------------------!
433     IF (P_TSOIL(i,1,j) .gt. 0. .and. JULYR .le. 8999) THEN
434       tsoil(subs,:)=P_TSOIL(i,:,j)
435     ELSE
436       IF ( (i == ips) .AND. (j == jps) ) PRINT *,'** Mars ** no tsoil. set it to tsurf.'
437       do k=1,nsoil
438        tsoil(subs,k) = P_TSURF(i,j)
439       enddo
440     ENDIF
441
442   ENDDO
443   ENDDO
444
445   volcapa=1.e6   
446
447   print*,'zolbxs'
448   !!---------------------!!
449   !! OUTPUT FOR CHECKING !!
450   !!---------------------!!
451   nlast = (ipe-ips+1)*(jpe-jps+1)
452   print*,"check: inertiedat",inertiedat(1,:),inertiedat(nlast,:)
453   print*,"check: mlayer",mlayer(:)
454   print*,"check: layer",layer(:)
455   print*,"check: tsoil",tsoil(1,:),tsoil(nlast,:)
456
457END SUBROUTINE update_inputs_physiq_soil
458
459!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
460!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
461SUBROUTINE update_inputs_physiq_turb( &
462            ims,ime,jms,jme,kms,kme,&
463            ips,ipe,jps,jpe,&
464            RESTART,isles,&
465            P_Q2,P_WSTAR)
466
467   use turb_mod, only: q2,wstar,turb_resolved
468   !use phys_state_var_mod, only : q2,
469
470   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
471   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
472   INTEGER :: i,j,subs,nlast     
473   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: P_WSTAR
474   REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(IN) :: P_Q2
475   LOGICAL, INTENT(IN ) :: RESTART,isles
476
477   !! to know if this is turbulence-resolving run or not
478
479   turb_resolved = isles
480   print*,'isles',isles
481
482   DO j = jps,jpe
483   DO i = ips,ipe
484
485     !-----------------------------------!
486     ! 1D subscript for physics "cursor" !
487     !-----------------------------------!
488     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
489
490     !PBL wind variance
491     IF (.not. restart) THEN
492      q2(subs,:) = 1.E-6     
493      wstar(subs)=0.
494     ELSE
495      q2(subs,:)=P_Q2(i,:,j)!
496      !q2(subs,:) = 1.e-3
497      wstar(subs)=P_WSTAR(i,j)
498     ENDIF
499
500   ENDDO
501   ENDDO
502 
503   !!---------------------!!
504   !! OUTPUT FOR CHECKING !!
505   !!---------------------!!
506   nlast = (ipe-ips+1)*(jpe-jps+1)
507   print*,"check: q2",q2(1,1)!,q2(nlast,:)
508   print*,"check: wstar",wstar(1),wstar(nlast)
509
510END SUBROUTINE update_inputs_physiq_turb
511
512!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
513!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
514SUBROUTINE update_inputs_physiq_rad( &
515            ims,ime,jms,jme,&
516            ips,ipe,jps,jpe,&
517            RESTART,&
518            P_FLUXRAD)
519
520   !use dimradmars_mod, only: fluxrad
521   use phys_state_var_mod, only : fluxrad
522
523   INTEGER, INTENT(IN) :: ims,ime,jms,jme
524   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
525   INTEGER :: i,j,subs,nlast     
526   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: P_FLUXRAD
527   LOGICAL, INTENT(IN ) :: RESTART
528
529   DO j = jps,jpe
530   DO i = ips,ipe
531
532     !-----------------------------------!
533     ! 1D subscript for physics "cursor" !
534     !-----------------------------------!
535     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
536
537     ! fluxrad_save
538     IF (.not. restart) THEN
539      fluxrad(subs)=0.
540     ELSE
541      fluxrad(subs)=P_FLUXRAD(i,j)
542     ENDIF
543     !! et fluxrad_sky ???!???
544
545   ENDDO
546   ENDDO
547 
548   !!---------------------!!
549   !! OUTPUT FOR CHECKING !!
550   !!---------------------!!
551   nlast = (ipe-ips+1)*(jpe-jps+1)
552   print*,"check: fluxrad",fluxrad(1),fluxrad(nlast)
553
554END SUBROUTINE update_inputs_physiq_rad
555
556!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
557!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
558SUBROUTINE update_inputs_physiq_slope( &
559            ims,ime,jms,jme,&
560            ips,ipe,jps,jpe,&
561            JULYR,&
562            SLPX,SLPY)
563
564   !USE module_model_constants, only: DEGRAD
565   !USE slope_mod, ONLY: theta_sl, psi_sl
566
567   INTEGER, INTENT(IN) :: ims,ime,jms,jme
568   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,JULYR
569   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN)  :: SLPX,SLPY
570   INTEGER :: i,j,subs,nlast
571
572END SUBROUTINE update_inputs_physiq_slope
573
574END MODULE update_inputs_physiq_mod
Note: See TracBrowser for help on using the repository browser.