SUBROUTINE phyredem (fichnom,dtime,radpas,co2_ppm,solaire, . rlat,rlon,tsol,tsoil,deltat,qsol,snow, . radsol,rugmer,agesno, . zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel, . t_ancien, q_ancien) IMPLICIT none c====================================================================== c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818 c Objet: Ecriture de l'etat de redemarrage pour la physique c====================================================================== #include "dimensions.h" #include "dimphy.h" #include "netcdf.inc" #include "indicesol.h" #include "dimsoil.h" #include "clesphys.h" #include "control.h" #include "temps.h" c====================================================================== CHARACTER*(*) fichnom REAL dtime INTEGER radpas REAL rlat(klon), rlon(klon) REAL co2_ppm REAL solaire REAL tsol(klon,nbsrf) REAL tsoil(klon,nsoilmx,nbsrf) REAL deltat(klon) REAL qsol(klon,nbsrf) REAL snow(klon,nbsrf) REAL radsol(klon) REAL rugmer(klon) REAL agesno(klon) REAL zmea(klon) REAL zstd(klon) REAL zsig(klon) REAL zgam(klon) REAL zthe(klon) REAL zpic(klon) REAL zval(klon) REAL rugsrel(klon) REAL t_ancien(klon,klev), q_ancien(klon,klev) c INTEGER nid, nvarid, idim1, idim2, idim3 INTEGER ierr INTEGER length PARAMETER (length=100) REAL tab_cntrl(length) c INTEGER isoil, nsrf CHARACTER*7 str7 CHARACTER*2 str2 c ierr = NF_CREATE(fichnom, NF_CLOBBER, nid) IF (ierr.NE.NF_NOERR) THEN write(6,*)' Pb d''ouverture du fichier '//fichnom write(6,*)' ierr = ', ierr CALL ABORT ENDIF c ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 28, . "Fichier redemmarage physique") c ierr = NF_DEF_DIM (nid, "index", length, idim1) ierr = NF_DEF_DIM (nid, "points_physiques", klon, idim2) ierr = NF_DEF_DIM (nid, "horizon_vertical", klon*klev, idim3) c ierr = NF_ENDDEF(nid) c DO ierr = 1, length tab_cntrl(ierr) = 0.0 ENDDO tab_cntrl(1) = dtime tab_cntrl(2) = radpas tab_cntrl(3) = co2_ppm tab_cntrl(4) = solaire tab_cntrl(5) = iflag_con tab_cntrl(6) = nbapp_rad IF( cycle_diurne ) tab_cntrl( 7 ) = 1. IF( soil_model ) tab_cntrl( 8 ) = 1. IF( new_oliq ) tab_cntrl( 9 ) = 1. IF( ok_orodr ) tab_cntrl(10 ) = 1. IF( ok_orolf ) tab_cntrl(11 ) = 1. tab_cntrl(13) = dayref tab_cntrl(14) = anneeref tab_cntrl(13) = day_end tab_cntrl(14) = anne_ini c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid) #else ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid) #endif ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22, . "Parametres de controle") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl) #endif c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid) #else ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid) #endif ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32, . "Longitudes de la grille physique") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlon) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,rlon) #endif c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid) #else ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid) #endif ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31, . "Latitudes de la grille physique") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlat) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,rlat) #endif c c DO nsrf = 1, nbsrf IF (nsrf.LE.99) THEN WRITE(str2,'(i2.2)') nsrf ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "TS"//str2, NF_DOUBLE, 1, idim2,nvarid) #else ierr = NF_DEF_VAR (nid, "TS"//str2, NF_FLOAT, 1, idim2,nvarid) #endif ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, . "Temperature de surface No."//str2) ierr = NF_ENDDEF(nid) ELSE PRINT*, "Trop de sous-mailles" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsol(1,nsrf)) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,tsol(1,nsrf)) #endif ENDDO c DO nsrf = 1, nbsrf DO isoil=1, nsoilmx IF (isoil.LE.99 .AND. nsrf.LE.99) THEN WRITE(str7,'(i2.2,"srf",i2.2)') isoil,nsrf ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "Tsoil"//str7,NF_DOUBLE,1,idim2,nvarid) #else ierr = NF_DEF_VAR (nid, "Tsoil"//str7,NF_FLOAT,1,idim2,nvarid) #endif ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 29, . "Temperature du sol No."//str7) ierr = NF_ENDDEF(nid) ELSE PRINT*, "Trop de couches" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil(1,isoil,nsrf)) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil(1,isoil,nsrf)) #endif ENDDO ENDDO c c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "DELTAT", NF_DOUBLE, 1, idim2,nvarid) #else ierr = NF_DEF_VAR (nid, "DELTAT", NF_FLOAT, 1, idim2,nvarid) #endif ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 33, . "Ecart de la SST (pour slab-ocean)") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,deltat) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,deltat) #endif c DO nsrf = 1, nbsrf IF (nsrf.LE.99) THEN WRITE(str2,'(i2.2)') nsrf ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid,"QS"//str2,NF_DOUBLE,1,idim2,nvarid) #else ierr = NF_DEF_VAR (nid,"QS"//str2,NF_FLOAT,1,idim2,nvarid) #endif ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 25, . "Humidite de surface No."//str2) ierr = NF_ENDDEF(nid) ELSE PRINT*, "Trop de sous-mailles" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,qsol(1,nsrf)) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,qsol(1,nsrf)) #endif ENDDO c DO nsrf = 1, nbsrf IF (nsrf.LE.99) THEN WRITE(str2,'(i2.2)') nsrf ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid,"SNOW"//str2,NF_DOUBLE,1,idim2,nvarid) #else ierr = NF_DEF_VAR (nid,"SNOW"//str2,NF_FLOAT,1,idim2,nvarid) #endif ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22, . "Neige de surface No."//str2) ierr = NF_ENDDEF(nid) ELSE PRINT*, "Trop de sous-mailles" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,snow(1,nsrf)) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,snow(1,nsrf)) #endif ENDDO c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "RADS", NF_DOUBLE, 1, idim2,nvarid) #else ierr = NF_DEF_VAR (nid, "RADS", NF_FLOAT, 1, idim2,nvarid) #endif ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, . "Rayonnement net a la surface") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,radsol) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,radsol) #endif c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "RUGMER", NF_DOUBLE, 1, idim2,nvarid) #else ierr = NF_DEF_VAR (nid, "RUGMER", NF_FLOAT, 1, idim2,nvarid) #endif ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28, . "Longueur de rugosite sur mer") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rugmer) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,rugmer) #endif c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "AGESNO", NF_DOUBLE, 1, idim2,nvarid) #else ierr = NF_DEF_VAR (nid, "AGESNO", NF_FLOAT, 1, idim2,nvarid) #endif ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 15, . "Age de la neige") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,agesno) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,agesno) #endif c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid) #else ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid) #endif ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea) #endif c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid) #else ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid) #endif ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd) #endif c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid) #else ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid) #endif ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig) #endif c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid) #else ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid) #endif ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam) #endif c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid) #else ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid) #endif ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe) #endif c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "ZPIC", NF_DOUBLE, 1, idim2,nvarid) #else ierr = NF_DEF_VAR (nid, "ZPIC", NF_FLOAT, 1, idim2,nvarid) #endif ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zpic) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,zpic) #endif c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "ZVAL", NF_DOUBLE, 1, idim2,nvarid) #else ierr = NF_DEF_VAR (nid, "ZVAL", NF_FLOAT, 1, idim2,nvarid) #endif ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zval) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,zval) #endif c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "RUGSREL", NF_DOUBLE, 1, idim2,nvarid) #else ierr = NF_DEF_VAR (nid, "RUGSREL", NF_FLOAT, 1, idim2,nvarid) #endif ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rugsrel) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,rugsrel) #endif c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid) #else ierr = NF_DEF_VAR (nid, "TANCIEN", NF_FLOAT, 1, idim3,nvarid) #endif ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,t_ancien) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,t_ancien) #endif c ierr = NF_REDEF (nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid, "QANCIEN", NF_DOUBLE, 1, idim3,nvarid) #else ierr = NF_DEF_VAR (nid, "QANCIEN", NF_FLOAT, 1, idim3,nvarid) #endif ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q_ancien) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,q_ancien) #endif c ierr = NF_CLOSE(nid) c RETURN END