Changeset 2293 for LMDZ5/trunk/libf/phylmd/phyredem.F90
- Timestamp:
- Jun 5, 2015, 9:16:07 PM (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/phyredem.F90
r2265 r2293 1 ! $Id$2 3 1 SUBROUTINE phyredem (fichnom) 4 2 ! 3 !------------------------------------------------------------------------------- 4 ! Author: Z.X. Li (LMD/CNRS), 1993/08/18 5 !------------------------------------------------------------------------------- 6 ! Purpose: Write restart state for physics. 7 !------------------------------------------------------------------------------- 5 8 USE dimphy 6 9 USE mod_grid_phy_lmdz … … 19 22 20 23 IMPLICIT none 21 !====================================================================== 22 ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818 23 ! Objet: Ecriture de l'etat de redemarrage pour la physique 24 !====================================================================== 25 include "netcdf.inc" 24 25 include "iniprint.h" 26 26 include "dimsoil.h" 27 27 include "clesphys.h" … … 49 49 INTEGER isoil, nsrf,isw 50 50 CHARACTER (len=7) :: str7 51 CHARACTER (len=2 ) :: str251 CHARACTER (len=256) :: nam, lnam 52 52 INTEGER :: it, iiq 53 53 … … 126 126 CALL put_field("FSIC", "fraction glace mer", pctsrf(:, is_sic)) 127 127 128 DO nsrf = 1, nbsrf 129 IF (nsrf.LE.99) THEN 130 WRITE(str2, '(i2.2)') nsrf 131 CALL put_field("TS"//str2, "Temperature de surface No."//str2, & 132 ftsol(:, nsrf)) 133 ELSE 134 PRINT*, "Trop de sous-mailles" 135 call abort_gcm("phyredem", "", 1) 136 ENDIF 137 ENDDO 128 IF(nbsrf>99) THEN 129 PRINT*, "Trop de sous-mailles"; CALL abort_gcm("phyredem", "", 1) 130 END IF 131 IF(nsoilmx>99) THEN 132 PRINT*, "Trop de sous-surfaces"; CALL abort_gcm("phyredem", "", 1) 133 END IF 134 135 CALL put_field_srf1("TS","Temperature",ftsol(:,:)) 138 136 139 137 ! ================== Albedo ======================================= 140 138 print*,'PHYREDEM NOUVEAU' 141 DO nsrf = 1, nbsrf 142 DO isw=1, nsw 143 IF (isw.LE.99 .AND. nsrf.LE.99) THEN 144 WRITE(str7, '(i2.2, "srf", i2.2)') isw, nsrf 145 print*,'PHYREDEM ',"A_dir_SW"//str7 146 CALL put_field("A_dir_SW"//str7, "Albedo direct du sol bande "//str7, & 147 falb_dir(:, isw, nsrf)) 148 CALL put_field("A_dif_SW"//str7, "Albedo difus du sol bande "//str7, & 149 falb_dif(:, isw, nsrf)) 150 ELSE 151 PRINT*, "Trop de couches" 152 call abort_gcm("phyredem", "", 1) 153 ENDIF 154 ENDDO 155 ENDDO 156 157 ! ================== Tsoil ======================================= 158 DO nsrf = 1, nbsrf 159 DO isoil=1, nsoilmx 160 IF (isoil.LE.99 .AND. nsrf.LE.99) THEN 161 WRITE(str7, '(i2.2, "srf", i2.2)') isoil, nsrf 162 CALL put_field("Tsoil"//str7, "Temperature du sol No."//str7, & 163 tsoil(:, isoil, nsrf)) 164 ELSE 165 PRINT*, "Trop de couches" 166 call abort_gcm("phyredem", "", 1) 167 ENDIF 168 ENDDO 169 ENDDO 170 171 DO nsrf = 1, nbsrf 172 IF (nsrf.LE.99) THEN 173 WRITE(str2, '(i2.2)') nsrf 174 CALL put_field("QS"//str2, "Humidite de surface No."//str2, & 175 qsurf(:, nsrf)) 176 ELSE 177 PRINT*, "Trop de sous-mailles" 178 call abort_gcm("phyredem", "", 1) 179 ENDIF 180 END DO 181 182 CALL put_field("QSOL", "Eau dans le sol (mm)", qsol) 183 184 DO nsrf = 1, nbsrf 185 IF (nsrf.LE.99) THEN 186 WRITE(str2, '(i2.2)') nsrf 187 CALL put_field("EVAP"//str2, "Evaporation de surface No."//str2 & 188 , fevap(:, nsrf)) 189 ELSE 190 PRINT*, "Trop de sous-mailles" 191 call abort_gcm("phyredem", "", 1) 192 ENDIF 193 ENDDO 194 195 DO nsrf = 1, nbsrf 196 IF (nsrf.LE.99) THEN 197 WRITE(str2, '(i2.2)') nsrf 198 CALL put_field("SNOW"//str2, "Neige de surface No."//str2, & 199 snow(:, nsrf)) 200 ELSE 201 PRINT*, "Trop de sous-mailles" 202 call abort_gcm("phyredem", "", 1) 203 ENDIF 204 ENDDO 139 CALL put_field_srf2("A_dir_SW","Albedo direct",falb_dir(:,:,:)) 140 CALL put_field_srf2("A_dif_SW","Albedo diffus",falb_dif(:,:,:)) 141 142 ! ================== Tsoil ========================================= 143 CALL put_field_srf2("Tsoil","Temperature",tsoil(:,:,:)) 144 145 CALL put_field_srf1("QS" , "Humidite",qsurf(:,:)) 146 147 CALL put_field ("QSOL", "Eau dans le sol (mm)", qsol) 148 149 CALL put_field_srf1("EVAP", "Evaporation", fevap(:,:)) 150 151 CALL put_field_srf1("SNOW", "Neige", fevap(:,:)) 205 152 206 153 CALL put_field("RADS", "Rayonnement net a la surface", radsol) … … 218 165 CALL put_field("snow_f", "precipitation solide", snow_fall) 219 166 220 DO nsrf = 1, nbsrf 221 IF (nsrf.LE.99) THEN 222 WRITE(str2, '(i2.2)') nsrf 223 CALL put_field("Z0m"//str2, "rugosite de surface No."//str2, & 224 z0m(:, nsrf)) 225 CALL put_field("Z0h"//str2, "rugosite de surface No."//str2, & 226 z0h(:, nsrf)) 227 ELSE 228 PRINT*, "Trop de sous-mailles" 229 call abort_gcm("phyredem", "", 1) 230 ENDIF 231 ENDDO 232 233 DO nsrf = 1, nbsrf 234 IF (nsrf.LE.99) THEN 235 WRITE(str2, '(i2.2)') nsrf 236 CALL put_field("AGESNO"//str2, & 237 "Age de la neige surface No."//str2, & 238 agesno(:, nsrf)) 239 ELSE 240 PRINT*, "Trop de sous-mailles" 241 call abort_gcm("phyredem", "", 1) 242 ENDIF 243 ENDDO 167 CALL put_field_srf1("Z0m", "rugosite", z0m(:,:)) 168 169 CALL put_field_srf1("Z0h", "rugosite", z0h(:,:)) 170 171 CALL put_field_srf1("AGESNO", "Age de la neige", agesno(:,:)) 244 172 245 173 CALL put_field("ZMEA", "ZMEA", zmea) … … 280 208 281 209 IF (iflag_pbl>1) then 282 DO nsrf = 1, nbsrf 283 IF (nsrf.LE.99) THEN 284 WRITE(str2, '(i2.2)') nsrf 285 CALL put_field("TKE"//str2, "Energ. Cineti. Turb."//str2, & 286 pbl_tke(:, 1:klev+1, nsrf)) 287 CALL put_field("DELTATKE"//str2, "Del TKE wk/env."//str2, & 288 wake_delta_pbl_tke(:, 1:klev+1, nsrf)) 289 ELSE 290 PRINT*, "Trop de sous-mailles" 291 call abort_gcm("phyredem", "", 1) 292 ENDIF 293 ENDDO 294 ENDIF 210 CALL put_field_srf3("TKE", "Energ. Cineti. Turb.", & 211 pbl_tke(:,:,:)) 212 CALL put_field_srf3("DELTATKE", "Del TKE wk/env.", & 213 wake_delta_pbl_tke(:,:,:)) 214 END IF 295 215 296 216 ! FIN TKE PBL ! … … 372 292 !$OMP BARRIER 373 293 294 295 CONTAINS 296 297 298 SUBROUTINE put_field_srf1(nam,lnam,field) 299 300 IMPLICIT NONE 301 CHARACTER(LEN=*), INTENT(IN) :: nam, lnam 302 REAL, INTENT(IN) :: field(:,:) 303 CHARACTER(LEN=256) :: nm, lm, str 304 DO nsrf = 1, nbsrf 305 WRITE(str, '(i2.2)') nsrf 306 nm=TRIM(nam)//TRIM(str) 307 lm=TRIM(lnam)//" de surface No. "//TRIM(str) 308 CALL put_field(nm,lm,field(:,nsrf)) 309 END DO 310 311 END SUBROUTINE put_field_srf1 312 313 314 SUBROUTINE put_field_srf2(nam,lnam,field) 315 316 IMPLICIT NONE 317 CHARACTER(LEN=*), INTENT(IN) :: nam, lnam 318 REAL, INTENT(IN) :: field(:,:,:) 319 CHARACTER(LEN=256) :: nm, lm, str 320 DO nsrf = 1, nbsrf 321 DO isoil=1, nsw 322 WRITE(str, '(i2.2,"srf",i2.2)')isoil,nsrf 323 ! WRITE(lunout,*)"PHYREDEM ",TRIM(nam)//TRIM(str) 324 nm=TRIM(nam)//TRIM(str) 325 lm=TRIM(lnam)//" du sol No. "//TRIM(str) 326 CALL put_field(nm,lm,field(:,isoil,nsrf)) 327 END DO 328 END DO 329 330 END SUBROUTINE put_field_srf2 331 332 333 SUBROUTINE put_field_srf3(nam,lnam,field) 334 335 IMPLICIT NONE 336 CHARACTER(LEN=*), INTENT(IN) :: nam, lnam 337 REAL, INTENT(IN) :: field(:,:,:) 338 CHARACTER(LEN=256) :: nm, lm, str 339 DO nsrf = 1, nbsrf 340 WRITE(str, '(i2.2)') nsrf 341 nm=TRIM(nam)//TRIM(str) 342 lm=TRIM(lnam)//TRIM(str) 343 CALL put_field(nm,lm,field(:,1:klev+1,nsrf)) 344 END DO 345 346 END SUBROUTINE put_field_srf3 347 348 374 349 END SUBROUTINE phyredem
Note: See TracChangeset
for help on using the changeset viewer.