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

Last change on this file was 2874, checked in by jleconte, 2 years ago

Changed nomenclature for planet variables from m_ to p_ in interface V4
File size: 6.9 KB
Line 
1MODULE update_outputs_physiq_mod
2
3CONTAINS
4
5!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
7SUBROUTINE update_outputs_physiq_surf( &
8            ims,ime,jms,jme,&
9            ips,ipe,jps,jpe,&
10            TRACER_MODE,&
11            P_TSURF,P_CO2ICE,&
12            P_H2OICE)
13
14   !use surfdat_h, only: tsurf, co2ice, qsurf
15   use phys_state_var_mod, only : tsurf,qsurf
16
17   INTEGER, INTENT(IN) :: ims,ime,jms,jme
18   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
19   INTEGER, INTENT(IN) :: TRACER_MODE
20   INTEGER :: i,j,subs
21   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
22     P_TSURF,P_CO2ICE,P_H2OICE
23
24   DO j = jps,jpe
25   DO i = ips,ipe
26
27     !-----------------------------------!
28     ! 1D subscript for physics "cursor" !
29     !-----------------------------------!
30     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
31
32     !-------------------------------------------------------!
33     ! Save key variables for restart and output and nesting ! 
34     !-------------------------------------------------------!
35     P_TSURF(i,j) = tsurf(subs)
36
37   ENDDO
38   ENDDO
39
40END SUBROUTINE update_outputs_physiq_surf
41
42!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
43!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
44SUBROUTINE update_outputs_physiq_soil( &
45            ims,ime,jms,jme,&
46            ips,ipe,jps,jpe,&
47            nsoil,&
48            P_TSOIL)
49
50   !use comsoil_h, only: tsoil
51    use phys_state_var_mod, only : tsoil
52
53   INTEGER, INTENT(IN) :: ims,ime,jms,jme
54   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,nsoil
55   INTEGER :: i,j,subs
56   REAL, DIMENSION( ims:ime, nsoil, jms:jme ), INTENT(INOUT)  :: &
57     P_TSOIL
58
59   DO j = jps,jpe
60   DO i = ips,ipe
61
62     !-----------------------------------!
63     ! 1D subscript for physics "cursor" !
64     !-----------------------------------!
65     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
66
67     !-------------------------------------------------------!
68     ! Save key variables for restart and output and nesting ! 
69     !-------------------------------------------------------!
70     P_TSOIL(i,:,j) = tsoil(subs,:)
71
72   ENDDO
73   ENDDO
74
75END SUBROUTINE update_outputs_physiq_soil
76
77!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
78!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
79SUBROUTINE update_outputs_physiq_rad( &
80            ims,ime,jms,jme,&
81            ips,ipe,jps,jpe,&
82            P_FLUXRAD)
83
84   !use dimradmars_mod, only: fluxrad
85   use phys_state_var_mod, only : fluxrad
86
87   INTEGER, INTENT(IN) :: ims,ime,jms,jme
88   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
89   INTEGER :: i,j,subs
90   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: P_FLUXRAD
91
92   DO j = jps,jpe
93   DO i = ips,ipe
94
95     !-----------------------------------!
96     ! 1D subscript for physics "cursor" !
97     !-----------------------------------!
98     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
99
100     !-------------------------------------------------------!
101     ! Save key variables for restart and output and nesting ! 
102     !-------------------------------------------------------!
103     P_FLUXRAD(i,j) = fluxrad(subs)
104
105   ENDDO
106   ENDDO
107
108END SUBROUTINE update_outputs_physiq_rad
109
110!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
111!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
112SUBROUTINE update_outputs_physiq_turb( &
113            ims,ime,jms,jme,kms,kme,&
114            ips,ipe,jps,jpe,kps,kpe,&
115            P_Q2,P_WSTAR,&
116            HFMAX,ZMAX,USTM,HFX)
117
118   use turb_mod, only: q2,wstar,ustar,sensibFlux!,&
119                        !hfmax_th,zmax_th
120   !use phys_state_var_mod, only : q2,sensibFlux
121
122   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
123   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
124   INTEGER :: i,j,subs   
125   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
126     P_WSTAR,HFMAX,ZMAX,USTM,HFX
127   REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(INOUT) :: P_Q2
128 
129   DO j = jps,jpe
130   DO i = ips,ipe
131
132     !-----------------------------------!
133     ! 1D subscript for physics "cursor" !
134     !-----------------------------------!
135     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
136
137     !-------------------------------------------------------!
138     ! Save key variables for restart and output and nesting ! 
139     !-------------------------------------------------------!
140     P_Q2(i,kps:kpe+1,j) = q2(subs,:)
141     P_WSTAR(i,j) = wstar(subs)
142     !! output only (arrays already in phys modules)
143     !HFMAX(i,j) = HFMAX_TH(subs)
144     !ZMAX(i,j) = ZMAX_TH(subs)
145     USTM(i,j) = ustar(subs)
146     HFX(i,j) = sensibFlux(subs) ! *-1 ?????
147
148   ENDDO
149   ENDDO
150
151END SUBROUTINE update_outputs_physiq_turb
152
153!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
154!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
155SUBROUTINE update_outputs_physiq_diag( &
156            ims,ime,jms,jme,kms,kme,&
157            ips,ipe,jps,jpe,kps,kpe,&
158            HR_SW,HR_LW,HR_DYN,DT_RAD,&
159            CLOUDFRAC,TOTCLOUDFRAC,RH,&
160            DQICE,DQVAP,REEVAP,SURFRAIN,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
161            FLUXSURF_LW,FLXGRD,DTLSC,DTRAIN,DT_MOIST,H2OICE_REFF,LATENT_HF)
162
163   USE comm_wrf !! to get fields to be written from physiq
164
165   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
166   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,kps,kpe
167   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
168     TOTCLOUDFRAC,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
169     FLUXSURF_LW,FLXGRD,LATENT_HF,REEVAP,SURFRAIN
170   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: &
171     HR_SW,HR_LW,CLOUDFRAC,HR_DYN,DT_RAD,RH,DQICE,DQVAP,&
172     DTLSC,DTRAIN,DT_MOIST,H2OICE_REFF
173   INTEGER :: i,j,subs
174
175   DO j = jps,jpe
176   DO i = ips,ipe
177
178     !-----------------------------------!
179     ! 1D subscript for physics "cursor" !
180     !-----------------------------------!
181     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
182
183     !! get diagnostics from physics
184     HR_SW(i,kps:kpe,j) = comm_HR_SW(subs,kps:kpe)
185     HR_LW(i,kps:kpe,j) = comm_HR_LW(subs,kps:kpe)
186     DT_RAD(i,kps:kpe,j) = HR_LW(i,kps:kpe,j) + HR_SW(i,kps:kpe,j)
187     CLOUDFRAC(i,kps:kpe,j) = comm_CLOUDFRAC(subs,kps:kpe)
188     TOTCLOUDFRAC(i,j) = comm_TOTCLOUDFRAC(subs)
189     RH(i,kps:kpe,j) = comm_RH(subs,kps:kpe)
190     DQICE(i,kps:kpe,j) = comm_DQICE(subs,kps:kpe)
191     DQVAP(i,kps:kpe,j) = comm_DQVAP(subs,kps:kpe)
192     HR_DYN(i,kps:kpe,j) = comm_HR_DYN(subs,kps:kpe)
193     ALBEQ(i,j)=comm_ALBEQ(subs)
194     FLUXTOP_DN(i,j) = comm_FLUXTOP_DN(subs)
195     FLUXABS_SW(i,j) = comm_FLUXABS_SW(subs)
196     FLUXTOP_LW(i,j) = comm_FLUXTOP_LW(subs)
197     FLUXSURF_SW(i,j) = comm_FLUXSURF_SW(subs)
198     FLUXSURF_LW(i,j) = comm_FLUXSURF_LW(subs)
199     FLXGRD(i,j) = comm_FLXGRD(subs)
200     DTLSC(i,kps:kpe,j) = comm_DTLSC(subs,kps:kpe)
201     DTRAIN(i,kps:kpe,j) = comm_DTRAIN(subs,kps:kpe)
202     DT_MOIST(i,kps:kpe,j) = DTRAIN(i,kps:kpe,j) + DTLSC(i,kps:kpe,j)
203     H2OICE_REFF(i,kps:kpe,j) = comm_H2OICE_REFF(subs,kps:kpe)
204     LATENT_HF(i,j) = comm_LATENT_HF(subs)
205     REEVAP(i,j) = comm_REEVAP(subs)
206     SURFRAIN(i,j) = comm_SURFRAIN(subs)
207
208
209   ENDDO
210   ENDDO
211
212   CALL deallocate_comm_wrf
213
214END SUBROUTINE update_outputs_physiq_diag
215
216END MODULE update_outputs_physiq_mod
217
218
219
Note: See TracBrowser for help on using the repository browser.