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

Last change on this file was 3194, checked in by emillour, 11 months ago

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