source: LMDZ6/branches/contrails/libf/phylmd/phyredem.f90 @ 5456

Last change on this file since 5456 was 5452, checked in by aborella, 40 hours ago

First implementation of the contrails parameterisation
Lacks the emission of H2O + the impact on radiative transfer

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 15.8 KB
RevLine 
[3080]1!
2! $Id: phyredem.f90 5452 2024-12-23 17:12:29Z aborella $
3!
[1827]4SUBROUTINE phyredem (fichnom)
[2293]5!
6!-------------------------------------------------------------------------------
7! Author: Z.X. Li (LMD/CNRS), 1993/08/18
8!-------------------------------------------------------------------------------
9! Purpose: Write restart state for physics.
10!-------------------------------------------------------------------------------
[5296]11USE compbl_mod_h
12  USE alpale_mod
[5284]13    USE clesphys_mod_h
[2395]14  USE dimphy, ONLY: klon, klev
[1827]15  USE fonte_neige_mod,  ONLY : fonte_neige_final
16  USE pbl_surface_mod,  ONLY : pbl_surface_final
[3888]17  USE phys_state_var_mod, ONLY: radpas, zmasq, pctsrf,                       &
18                                ftsol, beta_aridity, delta_tsurf, falb_dir,  &
[2395]19                                falb_dif, qsol, fevap, radsol, solsw, sollw, &
[4523]20                                sollwdown, rain_fall, snow_fall, bs_fall, z0m, z0h, &
[2499]21                                agesno, zmea, zstd, zsig, zgam, zthe, zpic,  &
22                                zval, rugoro, t_ancien, q_ancien,            &
[4523]23                                prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien,      &
[5204]24                                ql_ancien, qs_ancien, qbs_ancien, cf_ancien, &
[5452]25                                rvc_ancien, rcont_ancien, u_ancien, v_ancien,&
[5204]26                                clwcon, rnebcon, ratqs, pbl_tke,             &
[2499]27                                wake_delta_pbl_tke, zmax0, f0, sig1, w01,    &
[4744]28                                wake_deltat, wake_deltaq, wake_s, awake_s,   &
29                                wake_dens, awake_dens, cv_gen,               &
[2635]30                                wake_cstar,                                  &
[2499]31                                wake_pe, wake_fip, fm_therm, entr_therm,     &
[3080]32                                detr_therm, ale_bl, ale_bl_trig, alp_bl,     &
33                                ale_wake, ale_bl_stat,                       &
[3815]34                                du_gwd_rando, du_gwd_front, u10m, v10m, &
35                                treedrg, solswfdiff, delta_sal, ds_ns, dt_ns, &
[4613]36                                delta_sst, ratqs_inter_, dter, dser, dt_ds
[3815]37
[2395]38  USE geometry_mod, ONLY : longitude_deg, latitude_deg
[3506]39  USE iostart, ONLY: open_restartphy, close_restartphy, enddef_restartphy, put_field, put_var
[1827]40  USE traclmdz_mod, ONLY : traclmdz_to_restart
[4389]41  USE infotrac_phy, ONLY: type_trac, nqtot, tracers, nbtr
[4298]42  USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send, carbon_cycle_rad, RCO2_glo
[2395]43  USE indice_sol_mod, ONLY: nbsrf, is_oce, is_sic, is_ter, is_lic, epsfra
44  USE surface_data, ONLY: type_ocean, version_ocean
[2656]45  USE ocean_slab_mod, ONLY : nslay, tslab, seaice, tice, fsic
[2344]46  USE time_phylmdz_mod, ONLY: annee_ref, day_end, itau_phy, pdtphys
[5282]47  use config_ocean_skin_m, only: activate_ocean_skin
[5273]48  USE dimsoil_mod_h, ONLY: nsoilmx
[1827]49  IMPLICIT none
50  !======================================================================
51  CHARACTER*(*) fichnom
[967]52
[1827]53  ! les variables globales ecrites dans le fichier restart
[782]54
[1827]55  REAL tsoil(klon, nsoilmx, nbsrf)
56  REAL qsurf(klon, nbsrf)
57  REAL snow(klon, nbsrf)
58  real fder(klon)
59  REAL run_off_lic_0(klon)
60  REAL trs(klon, nbtr)
[782]61
[1827]62  INTEGER nid, nvarid, idim1, idim2, idim3
63  INTEGER ierr
64  INTEGER length
65  PARAMETER (length=100)
66  REAL tab_cntrl(length)
[782]67
[2237]68  INTEGER isoil, nsrf,isw
[2656]69  CHARACTER (len=2) :: str2
[2293]70  CHARACTER (len=256) :: nam, lnam
[4056]71  INTEGER           :: it, iq, pass
[524]72
[1827]73  !======================================================================
[524]74
[1827]75  ! Get variables which will be written to restart file from module
76  ! pbl_surface_mod
[4551]77  if ( iflag_physiq <= 1 ) then
[4537]78     CALL pbl_surface_final(fder, snow, qsurf,  tsoil)
79  endif
[1279]80
[1827]81  ! Get a variable calculated in module fonte_neige_mod
82  CALL fonte_neige_final(run_off_lic_0)
[1001]83
[1827]84  !======================================================================
[1001]85
[1827]86  CALL open_restartphy(fichnom)
[1001]87
[3506]88 
[1827]89  DO ierr = 1, length
90     tab_cntrl(ierr) = 0.0
91  ENDDO
[2344]92  tab_cntrl(1) = pdtphys
[1827]93  tab_cntrl(2) = radpas
94  ! co2_ppm : current value of atmospheric CO2
95  tab_cntrl(3) = co2_ppm
96  tab_cntrl(4) = solaire
97  tab_cntrl(5) = iflag_con
98  tab_cntrl(6) = nbapp_rad
[524]99
[3317]100  IF( iflag_cycle_diurne.GE.1 ) tab_cntrl( 7 ) = iflag_cycle_diurne
[1827]101  IF(   soil_model ) tab_cntrl( 8 ) = 1.
102  IF(     new_oliq ) tab_cntrl( 9 ) = 1.
103  IF(     ok_orodr ) tab_cntrl(10 ) = 1.
104  IF(     ok_orolf ) tab_cntrl(11 ) = 1.
[524]105
[1827]106  tab_cntrl(13) = day_end
107  tab_cntrl(14) = annee_ref
108  tab_cntrl(15) = itau_phy
109
110  ! co2_ppm0 : initial value of atmospheric CO2
[4298]111  ! tab_cntrl(16) = co2_ppm0
[1827]112
[4298]113  !  PC -- initial value of RCO2 for the radiation scheme
114  !  tab_cntrl(17) = co2_ppm * 1.0e-06 * RMCO2 / RMD
115  IF (carbon_cycle_rad) tab_cntrl(17) = RCO2_glo
116  !PRINT*, "PC : phyredem RCO2_glo =",RCO2_glo
117
[3506]118  DO pass=1,2   ! pass=1 netcdf definition ; pass=2 netcdf write
119 
120    CALL put_var(pass, "controle", "Parametres de controle", tab_cntrl)
[1827]121
[3506]122    CALL put_field(pass,"longitude", &
123         "Longitudes de la grille physique", longitude_deg)
[1827]124
[3506]125    CALL put_field(pass,"latitude", "Latitudes de la grille physique", latitude_deg)
[1827]126
[3506]127    ! PB ajout du masque terre/mer
[1827]128
[3506]129    CALL put_field(pass,"masque", "masque terre mer", zmasq)
[1827]130
[3506]131    ! BP ajout des fraction de chaque sous-surface
[1827]132
[3506]133    ! Get last fractions from slab ocean
134    IF (type_ocean == 'slab' .AND. version_ocean == "sicINT") THEN
135        WHERE (1.-zmasq(:).GT.EPSFRA)
136            pctsrf(:,is_oce)=(1.-fsic(:))*(1.-zmasq(:))
137            pctsrf(:,is_sic)=fsic(:)*(1.-zmasq(:))
138        END WHERE
139    END IF
[2209]140
[3506]141    ! 1. fraction de terre
[1827]142
[3506]143    CALL put_field(pass,"FTER", "fraction de continent", pctsrf(:, is_ter))
[1827]144
[3506]145    ! 2. Fraction de glace de terre
[1827]146
[3506]147    CALL put_field(pass,"FLIC", "fraction glace de terre", pctsrf(:, is_lic))
148    ! 3. fraction ocean
[1827]149
[3506]150    CALL put_field(pass,"FOCE", "fraction ocean", pctsrf(:, is_oce))
[1827]151
[3506]152    ! 4. Fraction glace de mer
[1827]153
[3506]154    CALL put_field(pass,"FSIC", "fraction glace mer", pctsrf(:, is_sic))
[1827]155
[3506]156    IF(nbsrf>99) THEN
157      PRINT*, "Trop de sous-mailles";  CALL abort_physic("phyredem", "", 1)
158    END IF
159    IF(nsoilmx>99) THEN
160      PRINT*, "Trop de sous-surfaces"; CALL abort_physic("phyredem", "", 1)
161    END IF
162    IF(nsw>99) THEN
163      PRINT*, "Trop de bandes"; CALL abort_physic("phyredem", "", 1)
164    END IF
[1827]165
[3888]166!    Surface variables
[3506]167    CALL put_field_srf1(pass,"TS","Temperature",ftsol(:,:))
[2293]168
[4035]169    IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1) then
170       CALL put_field_srf1(pass, "DELTATS", &
171            "w-x surface temperature difference", delta_tsurf(:,:))
172       CALL put_field_srf1(pass,"BETAS","Aridity factor", beta_aridity(:,:))
173    end IF
[3888]174!    End surface variables
175
[2237]176! ================== Albedo =======================================
[3506]177    print*,'PHYREDEM NOUVEAU'
178    CALL put_field_srf2(pass,"A_dir_SW","Albedo direct",falb_dir(:,:,:))
179    CALL put_field_srf2(pass,"A_dif_SW","Albedo diffus",falb_dif(:,:,:))
[2237]180
[3506]181    CALL put_field_srf1(pass,"U10M", "u a 10m", u10m)
[2569]182
[3506]183    CALL put_field_srf1(pass,"V10M", "v a 10m", v10m)
[2569]184
185
[2293]186! ================== Tsoil =========================================
[3506]187    CALL put_field_srf2(pass,"Tsoil","Temperature",tsoil(:,:,:))
[2952]188!FC
189!  CALL put_field_srf2("treedrg","freinage arbres",treedrg(:,:,:))
[3506]190    CALL put_field(pass,"treedrg_ter","freinage arbres",treedrg(:,:,is_ter))
[524]191
[2952]192
[3506]193    CALL put_field_srf1(pass,"QS"  , "Humidite",qsurf(:,:))
[1827]194
[3506]195    CALL put_field     (pass,"QSOL", "Eau dans le sol (mm)", qsol)
[1827]196
[3506]197    CALL put_field_srf1(pass,"EVAP", "Evaporation", fevap(:,:))
[1827]198
[3506]199    CALL put_field_srf1(pass,"SNOW", "Neige", snow(:,:))
[1827]200
[3506]201    CALL put_field(pass,"RADS", "Rayonnement net a la surface", radsol)
[1827]202
[3506]203    CALL put_field(pass,"solsw", "Rayonnement solaire a la surface", solsw)
[1827]204
[3756]205    CALL put_field(pass,"solswfdiff", "Fraction du rayonnement solaire a la surface qui est diffus", solswfdiff)
206
[3506]207    CALL put_field(pass,"sollw", "Rayonnement IF a la surface", sollw)
[1827]208
[3506]209    CALL put_field(pass,"sollwdown", "Rayonnement down IF a la surface", sollwdown)
[2188]210
[3506]211    CALL put_field(pass,"fder", "Derive de flux", fder)
[1827]212
[3506]213    CALL put_field(pass,"rain_f", "precipitation liquide", rain_fall)
[1827]214
[3506]215    CALL put_field(pass,"snow_f", "precipitation solide", snow_fall)
[1827]216
[3506]217    CALL put_field_srf1(pass,"Z0m", "rugosite", z0m(:,:))
[1827]218
[3506]219    CALL put_field_srf1(pass,"Z0h", "rugosite", z0h(:,:))
[1827]220
[3506]221    CALL put_field_srf1(pass,"AGESNO", "Age de la neige", agesno(:,:))
[2293]222
[3506]223    CALL put_field(pass,"ZMEA", "ZMEA", zmea)
[1827]224
[3506]225    CALL put_field(pass,"ZSTD", "ZSTD", zstd)
[1827]226
[3506]227    CALL put_field(pass,"ZSIG", "ZSIG", zsig)
[1827]228
[3506]229    CALL put_field(pass,"ZGAM", "ZGAM", zgam)
[1827]230
[3506]231    CALL put_field(pass,"ZTHE", "ZTHE", zthe)
[1827]232
[3506]233    CALL put_field(pass,"ZPIC", "ZPIC", zpic)
[1827]234
[3506]235    CALL put_field(pass,"ZVAL", "ZVAL", zval)
[1827]236
[3506]237    CALL put_field(pass,"RUGSREL", "RUGSREL", rugoro)
[1827]238
[3506]239    CALL put_field(pass,"TANCIEN", "TANCIEN", t_ancien)
[1827]240
[3506]241    CALL put_field(pass,"QANCIEN", "QANCIEN", q_ancien)
[1827]242
[3506]243    CALL put_field(pass,"QLANCIEN", "QLANCIEN", ql_ancien)
[2497]244
[3506]245    CALL put_field(pass,"QSANCIEN", "QSANCIEN", qs_ancien)
[2497]246
[4523]247    IF (ok_bs) THEN
248       CALL put_field(pass,"bs_f", "precipitation neige soufflee", bs_fall)
249       CALL put_field(pass,"QBSANCIEN", "QBSANCIEN", qbs_ancien)
250       CALL put_field(pass,"PRBSWANCIEN", "PRBSWANCIEN", prbsw_ancien)
251    ENDIF
252
[5204]253    IF ( ok_ice_supersat ) THEN
254      CALL put_field(pass,"CFANCIEN", "CFANCIEN", cf_ancien)
255      CALL put_field(pass,"RVCANCIEN", "RVCANCIEN", rvc_ancien)
256    ENDIF
[4059]257
[5452]258    IF ( ok_plane_contrail ) THEN
259      CALL put_field(pass,"RCONTANCIEN", "RCONTANCIEN", rcont_ancien)
260    ENDIF
261
[3506]262    CALL put_field(pass,"PRWANCIEN", "PRWANCIEN", prw_ancien)
[1827]263
[3506]264    CALL put_field(pass,"PRLWANCIEN", "PRLWANCIEN", prlw_ancien)
[1827]265
[3506]266    CALL put_field(pass,"PRSWANCIEN", "PRSWANCIEN", prsw_ancien)
[2499]267
[3506]268    CALL put_field(pass,"UANCIEN", "UANCIEN", u_ancien)
[2499]269
[3506]270    CALL put_field(pass,"VANCIEN", "VANCIEN", v_ancien)
[2499]271
[3506]272    CALL put_field(pass,"CLWCON", "Eau liquide convective", clwcon)
[1827]273
[3506]274    CALL put_field(pass,"RNEBCON", "Nebulosite convective", rnebcon)
[1827]275
[3506]276    CALL put_field(pass,"RATQS", "Ratqs", ratqs)
[1827]277
[3506]278    ! run_off_lic_0
[1827]279
[3506]280    CALL put_field(pass,"RUNOFFLIC0", "Runofflic0", run_off_lic_0)
[1827]281
[3506]282    ! DEB TKE PBL !
[1827]283
[3506]284    IF (iflag_pbl>1) then
285      CALL put_field_srf3(pass,"TKE", "Energ. Cineti. Turb.", &
286           pbl_tke(:,:,:))
287      CALL put_field_srf3(pass,"DELTATKE", "Del TKE wk/env.", &
288           wake_delta_pbl_tke(:,:,:))
289    END IF
[1619]290
[3506]291    ! FIN TKE PBL !
292    !IM ajout zmax0, f0, sig1, w01
293    !IM wake_deltat, wake_deltaq, wake_s, wake_cstar, wake_pe, wake_fip
[1619]294
[3506]295    CALL put_field(pass,"ZMAX0", "ZMAX0", zmax0)
[1619]296
[3506]297    CALL put_field(pass,"F0", "F0", f0)
[878]298
[3506]299    CALL put_field(pass,"sig1", "sig1 Emanuel", sig1)
[1001]300
[3506]301    CALL put_field(pass,"w01", "w01 Emanuel", w01)
[1001]302
[3506]303    ! wake_deltat
304    CALL put_field(pass,"WAKE_DELTAT", "WAKE_DELTAT", wake_deltat)
[1279]305
[3506]306    CALL put_field(pass,"WAKE_DELTAQ", "WAKE_DELTAQ", wake_deltaq)
[1403]307
[3506]308    CALL put_field(pass,"WAKE_S", "Wake frac. area", wake_s)
[1403]309
[4744]310    CALL put_field(pass,"AWAKE_S", "Active Wake frac. area", awake_s)
311
[3506]312    CALL put_field(pass,"WAKE_DENS", "Wake num. /unit area", wake_dens)
[2635]313
[3956]314    CALL put_field(pass,"AWAKE_DENS", "Active Wake num. /unit area", awake_dens)
315
316    CALL put_field(pass,"CV_GEN", "CB birth rate", cv_gen)
317
[3506]318    CALL put_field(pass,"WAKE_CSTAR", "WAKE_CSTAR", wake_cstar)
[1403]319
[3506]320    CALL put_field(pass,"WAKE_PE", "WAKE_PE", wake_pe)
[1403]321
[3506]322    CALL put_field(pass,"WAKE_FIP", "WAKE_FIP", wake_fip)
[1279]323
[3506]324    ! thermiques
[1827]325
[3506]326    CALL put_field(pass,"FM_THERM", "FM_THERM", fm_therm)
[1827]327
[3506]328    CALL put_field(pass,"ENTR_THERM", "ENTR_THERM", entr_therm)
[1827]329
[3506]330    CALL put_field(pass,"DETR_THERM", "DETR_THERM", detr_therm)
[1827]331
[3506]332    CALL put_field(pass,"ALE_BL", "ALE_BL", ale_bl)
[2069]333
[3506]334    CALL put_field(pass,"ALE_BL_TRIG", "ALE_BL_TRIG", ale_bl_trig)
[2069]335
[3506]336    CALL put_field(pass,"ALP_BL", "ALP_BL", alp_bl)
[2069]337
[3506]338    CALL put_field(pass,"ALE_WAKE", "ALE_WAKE", ale_wake)
[3080]339
[3506]340    CALL put_field(pass,"ALE_BL_STAT", "ALE_BL_STAT", ale_bl_stat)
[3080]341
342
[3856]343    ! fisrtilp/clouds
[4613]344    CALL put_field(pass,"RATQS_INTER","Relative width of the lsc sugrid scale water",ratqs_inter_)
[3856]345
346
[4389]347    IF (ANY(type_trac == ['co2i','inco'])) THEN
[4170]348       IF (carbon_cycle_cpl) THEN
349          IF (.NOT. ALLOCATED(co2_send)) THEN
350             ! This is the case of create_etat0_limit, ce0l
351             ALLOCATE(co2_send(klon))
352             co2_send(:) = co2_ppm0
353          END IF
354          CALL put_field(pass,"co2_send", "co2_ppm for coupling", co2_send)
355       END IF
356
[3506]357    ! trs from traclmdz_mod
[4263]358    ELSE IF (type_trac == 'lmdz') THEN
[3506]359       CALL traclmdz_to_restart(trs)
[4056]360       it = 0
361       DO iq = 1, nqtot
[4071]362          IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
[4056]363          it = it+1
364          CALL put_field(pass,"trs_"//tracers(iq)%name, "", trs(:, it))
[3506]365       END DO
[3933]366    END IF
367
[3506]368    ! Restart variables for Slab ocean
369    IF (type_ocean == 'slab') THEN
370        IF (nslay.EQ.1) THEN
371          CALL put_field(pass,"tslab", "Slab ocean temperature", tslab)
372        ELSE
373          DO it=1,nslay
374            WRITE(str2,'(i2.2)') it
375            CALL put_field(pass,"tslab"//str2, "Slab ocean temperature", tslab(:,it))
376          END DO
[1827]377        END IF
[3506]378        IF (version_ocean == 'sicINT') THEN
379            CALL put_field(pass,"seaice", "Slab seaice (kg/m2)", seaice)
380            CALL put_field(pass,"slab_tice", "Slab sea ice temperature", tice)
381        END IF
382    END IF
[1827]383
[3506]384    if (ok_gwd_rando) call put_field(pass,"du_gwd_rando", &
385         "tendency on zonal wind due to flott gravity waves", du_gwd_rando)
[2057]386
[3506]387    IF (.not. ok_hines .and. ok_gwd_rando) call put_field(pass,"du_gwd_front", &
388         "tendency on zonal wind due to acama gravity waves", du_gwd_front)
[1938]389
[3815]390    if (activate_ocean_skin >= 1) then
391       if (activate_ocean_skin == 2 .and. type_ocean == 'couple') then
392          CALL put_field(pass, "delta_sal", &
393               "ocean-air interface salinity minus bulk salinity", delta_sal)
394          CALL put_field(pass, "delta_SST", &
395               "ocean-air interface temperature minus bulk SST", delta_sst)
[4370]396          CALL put_field(pass, "dter", &
397               "ocean-air interface temperature minus subskin temperature", &
398               dter)
399          CALL put_field(pass, "dser", &
400               "ocean-air interface salinity minus subskin salinity", dser)
401          CALL put_field(pass, "dt_ds", &
402               "(tks / tkt) * dTer", dt_ds)
[3815]403       end if
404       
405       CALL put_field(pass, "dS_ns", "delta salinity near surface", ds_ns)
406       CALL put_field(pass, "dT_ns", "delta temperature near surface", dT_ns)
407    end if
408   
[3506]409    IF (pass==1) CALL enddef_restartphy
410    IF (pass==2) CALL close_restartphy
[4046]411  ENDDO ! DO pass=1,2   ! pass=1 netcdf definition ; pass=2 netcdf write
[3506]412 
[1827]413  !$OMP BARRIER
414
[2293]415
416  CONTAINS
417
418
[3506]419SUBROUTINE put_field_srf1(pass,nam,lnam,field)
[2293]420
421  IMPLICIT NONE
[4056]422  INTEGER, INTENT(IN)           :: pass
[2293]423  CHARACTER(LEN=*),  INTENT(IN) :: nam, lnam
424  REAL,              INTENT(IN) :: field(:,:)
425  CHARACTER(LEN=256) :: nm, lm, str
[2299]426  DO nsrf = 1, SIZE(field,2)
[2293]427    WRITE(str, '(i2.2)') nsrf
428    nm=TRIM(nam)//TRIM(str)
429    lm=TRIM(lnam)//" de surface No. "//TRIM(str)
[3506]430    CALL put_field(pass,nm,lm,field(:,nsrf))
[2293]431  END DO
432
433END SUBROUTINE put_field_srf1
434
435
[3506]436SUBROUTINE put_field_srf2(pass,nam,lnam,field)
[2293]437
438  IMPLICIT NONE
[3506]439  INTEGER, INTENT(IN)            :: pass
[2293]440  CHARACTER(LEN=*),  INTENT(IN) :: nam, lnam
441  REAL,              INTENT(IN) :: field(:,:,:)
442  CHARACTER(LEN=256) :: nm, lm, str
[2299]443  DO nsrf = 1, SIZE(field,3)
444    DO isoil=1, SIZE(field,2)
[2293]445      WRITE(str, '(i2.2,"srf",i2.2)')isoil,nsrf
446!      WRITE(lunout,*)"PHYREDEM ",TRIM(nam)//TRIM(str)
447      nm=TRIM(nam)//TRIM(str)
448      lm=TRIM(lnam)//" du sol No. "//TRIM(str)
[3506]449      CALL put_field(pass,nm,lm,field(:,isoil,nsrf))
[2293]450    END DO
451  END DO
452
453END SUBROUTINE put_field_srf2
454
455
[3506]456SUBROUTINE put_field_srf3(pass,nam,lnam,field)
[2293]457
458  IMPLICIT NONE
[3506]459  INTEGER, INTENT(IN)            :: pass
[2293]460  CHARACTER(LEN=*),  INTENT(IN) :: nam, lnam
461  REAL,              INTENT(IN) :: field(:,:,:)
462  CHARACTER(LEN=256) :: nm, lm, str
[2299]463  DO nsrf = 1, SIZE(field,3)
[2293]464    WRITE(str, '(i2.2)') nsrf
465    nm=TRIM(nam)//TRIM(str)
466    lm=TRIM(lnam)//TRIM(str)
[3506]467    CALL put_field(pass,nm,lm,field(:,1:klev+1,nsrf))
[2293]468  END DO
469
470END SUBROUTINE put_field_srf3
471
472
[1827]473END SUBROUTINE phyredem
Note: See TracBrowser for help on using the repository browser.