Ignore:
Timestamp:
Apr 29, 2025, 4:26:22 PM (2 months ago)
Author:
afalco
Message:

Generic/Pluto?: create restartfi if it does not exist when opening it.
AF

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.GENERIC/libf/phystd/iostart.F90

    r3708 r3747  
    66    ! INTEGER,SAVE :: nid_restart ! NetCDF file identifier for restartfi.nc file
    77!$OMP THREADPRIVATE(nid_start)
    8    
     8
    99    ! restartfi.nc file dimension identifiers: (see open_restartphy())
    1010    INTEGER,SAVE :: idim1 ! "index" dimension
    … …  
    2424    INTEGER,PARAMETER :: ldscrpt = 35 ! size of dscrpt_tab_cntrl array
    2525    INTEGER,PARAMETER :: ndscrpt = 50 ! size of characters in dscrpt_tab_cntrl array
    26    
     26
    2727    INTERFACE get_field
    2828      MODULE PROCEDURE Get_field_r1,Get_field_r2,Get_field_r3
    2929    END INTERFACE get_field
    30    
     30
    3131    INTERFACE get_var
    3232      MODULE PROCEDURE get_var_r0,Get_var_r1,Get_var_r2,Get_var_r3
    … …  
    4646    PUBLIC inquire_field, inquire_field_ndims
    4747    PUBLIC open_startphy,close_startphy,create_restartphy,open_restartphy,close_restartphy
    48    
     48
    4949CONTAINS
    5050
    … …  
    6565      ENDIF
    6666    ENDIF
    67    
     67
    6868    CALL bcast(nid_start) ! tell all procs about nid_start
    69  
     69
    7070  END SUBROUTINE open_startphy
    7171
    … …  
    9494    INTEGER :: varid
    9595    INTEGER :: ierr
    96    
     96
    9797    IF (is_master) THEN
    9898      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
    … …  
    110110
    111111  FUNCTION inquire_field_ndims(nid_start,Field_name)
    112   ! give the number of dimensions of "Field_name" stored in the input file 
     112  ! give the number of dimensions of "Field_name" stored in the input file
    113113  USE netcdf, only: nf90_inq_varid, nf90_inquire_variable, &
    114114                    NF90_NOERR, nf90_strerror
    … …  
    120120    INTEGER :: varid
    121121    INTEGER :: ierr
    122    
     122
    123123    IF (is_master) THEN
    124124      ierr=nf90_inq_varid(nid_start,Field_name,varid)
    … …  
    148148    INTEGER :: varid
    149149    INTEGER :: ierr
    150    
     150
    151151    IF (is_master) THEN
    152152      ierr=NF90_INQ_DIMID(nid_start,Field_name,varid)
    … …  
    173173    INTEGER :: varid
    174174    INTEGER :: ierr
    175    
     175
    176176    IF (is_master) THEN
    177177      ierr=nf90_inq_dimid(nid_start,Field_name,varid)
    … …  
    199199    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
    200200    REAL,INTENT(INOUT)               :: Field(:)
    201     LOGICAL,INTENT(OUT),OPTIONAL   :: found 
     201    LOGICAL,INTENT(OUT),OPTIONAL   :: found
    202202    INTEGER,INTENT(IN),OPTIONAL    :: timeindex ! time index of sought data
    203203
    … …  
    216216      CALL Get_field_rgen(nid_start,field_name,field,1,corners,edges)
    217217    ENDIF
    218      
     218
    219219  END SUBROUTINE Get_Field_r1
    220  
     220
    221221  SUBROUTINE Get_Field_r2(nid_start,field_name,field,found,timeindex)
    222222  ! For a "3D" horizontal-vertical field
    … …  
    226226    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
    227227    REAL,INTENT(INOUT)               :: Field(:,:)
    228     LOGICAL,INTENT(OUT),OPTIONAL   :: found 
     228    LOGICAL,INTENT(OUT),OPTIONAL   :: found
    229229    INTEGER,INTENT(IN),OPTIONAL    :: timeindex ! time index of sought data
    230230
    … …  
    238238      corners(3)=timeindex
    239239    endif
    240    
     240
    241241    IF (PRESENT(found)) THEN
    242242      CALL Get_field_rgen(nid_start,field_name,field,size(field,2),&
    … …  
    247247    ENDIF
    248248
    249      
     249
    250250  END SUBROUTINE Get_Field_r2
    251  
     251
    252252  SUBROUTINE Get_Field_r3(nid_start,field_name,field,found,timeindex)
    253253  ! for a "4D" field surf/alt/??
    … …  
    257257    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
    258258    REAL,INTENT(INOUT)               :: Field(:,:,:)
    259     LOGICAL,INTENT(OUT),OPTIONAL   :: found 
     259    LOGICAL,INTENT(OUT),OPTIONAL   :: found
    260260    INTEGER,INTENT(IN),OPTIONAL    :: timeindex ! time index of sought data
    261261
    … …  
    270270      corners(4)=timeindex
    271271    endif
    272    
     272
    273273    IF (PRESENT(found)) THEN
    274274      CALL Get_field_rgen(nid_start,field_name,field,size(field,2)*size(field,3),&
    … …  
    278278                          corners,edges)
    279279    ENDIF
    280      
     280
    281281  END SUBROUTINE Get_Field_r3
    282  
     282
    283283  SUBROUTINE Get_field_rgen(nid_start,field_name,field,field_size, &
    284284                            corners,edges,found)
    … …  
    296296    INTEGER,INTENT(IN) :: edges(4)
    297297    LOGICAL,OPTIONAL,INTENT(OUT) :: found
    298    
     298
    299299    REAL    :: field_glo(klon_glo,field_size) ! field on global grid
    300300    REAL :: field_glo_tmp(klon_glo,field_size)
    … …  
    303303    INTEGER :: varid
    304304    INTEGER :: ierr, i
    305    
     305
    306306    ! gather columns indexes on global grid
    307307    CALL gather(ind_cell_glo,ind_cell_glo_glo)
    308308
    309309    IF (is_master) THEN
    310  
     310
    311311      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
    312      
     312
    313313      IF (ierr==NF90_NOERR) THEN
    314314        CALL body(field_glo_tmp,nid_start)
    … …  
    317317        tmp_found=.FALSE.
    318318      ENDIF
    319    
     319
    320320    ENDIF ! of IF (is_master)
    321    
     321
    322322    CALL bcast(tmp_found)
    323323
    … …  
    331331      CALL scatter(field_glo,field)
    332332    ENDIF
    333    
     333
    334334    IF (PRESENT(found)) THEN
    335335      found=tmp_found
    … …  
    340340      ENDIF
    341341    ENDIF
    342  
    343    
     342
     343
    344344    CONTAINS
    345      
     345
    346346     SUBROUTINE body(field_glo,nid_start)
    347347       REAL :: field_glo(klon_glo*field_size)
    … …  
    349349         ierr=NF90_GET_VAR(nid_start,varid,field_glo,corners,edges)
    350350         IF (ierr/=NF90_NOERR) THEN
    351            ! La variable exist dans le fichier mais la lecture a echouee. 
     351           ! La variable exist dans le fichier mais la lecture a echouee.
    352352           PRINT*, 'get_field_rgen: Failed reading <'//field_name//'>'
    353353
    … …  
    362362  SUBROUTINE get_var_r0(nid_start,var_name,var,found)
    363363  ! Get a scalar from input file
    364   IMPLICIT NONE 
     364  IMPLICIT NONE
    365365    INTEGER,INTENT(IN)           :: nid_start
    366366    CHARACTER(LEN=*),INTENT(IN)  :: var_name
    … …  
    369369
    370370    REAL                         :: varout(1)
    371    
     371
    372372    IF (PRESENT(found)) THEN
    373373      CALL Get_var_rgen(nid_start,var_name,varout,size(varout),found)
    … …  
    376376    ENDIF
    377377    var=varout(1)
    378  
     378
    379379  END SUBROUTINE get_var_r0
    380380
    381381  SUBROUTINE get_var_r1(nid_start,var_name,var,found)
    382382  ! Get a vector from input file
    383   IMPLICIT NONE 
     383  IMPLICIT NONE
    384384    CHARACTER(LEN=*),INTENT(IN)  :: var_name
    385385    REAL,INTENT(INOUT)             :: var(:)
    386386    LOGICAL,OPTIONAL,INTENT(OUT) :: found
    387387    INTEGER,INTENT(IN)           :: nid_start
    388    
     388
    389389    IF (PRESENT(found)) THEN
    390390      CALL Get_var_rgen(nid_start,var_name,var,size(var),found)
    … …  
    392392      CALL Get_var_rgen(nid_start,var_name,var,size(var))
    393393    ENDIF
    394  
     394
    395395  END SUBROUTINE get_var_r1
    396396
    397397  SUBROUTINE get_var_r2(nid_start,var_name,var,found)
    398398  ! Get a 2D field from input file
    399   IMPLICIT NONE 
     399  IMPLICIT NONE
    400400    CHARACTER(LEN=*),INTENT(IN)  :: var_name
    401401    REAL,INTENT(OUT)             :: var(:,:)
    402402    LOGICAL,OPTIONAL,INTENT(OUT) :: found
    403403    INTEGER,INTENT(IN)           :: nid_start
    404    
     404
    405405    IF (PRESENT(found)) THEN
    406406      CALL Get_var_rgen(nid_start,var_name,var,size(var),found)
    … …  
    408408      CALL Get_var_rgen(nid_start,var_name,var,size(var))
    409409    ENDIF
    410  
     410
    411411  END SUBROUTINE get_var_r2
    412412
    413413  SUBROUTINE get_var_r3(nid_start,var_name,var,found)
    414414  ! Get a 3D field frominput file
    415   IMPLICIT NONE 
     415  IMPLICIT NONE
    416416    CHARACTER(LEN=*),INTENT(IN)  :: var_name
    417417    REAL,INTENT(INOUT)             :: var(:,:,:)
    418418    LOGICAL,OPTIONAL,INTENT(OUT) :: found
    419419    INTEGER,INTENT(IN)           :: nid_start
    420    
     420
    421421    IF (PRESENT(found)) THEN
    422422      CALL Get_var_rgen(nid_start,var_name,var,size(var),found)
    … …  
    424424      CALL Get_var_rgen(nid_start,var_name,var,size(var))
    425425    ENDIF
    426  
     426
    427427  END SUBROUTINE get_var_r3
    428428
    … …  
    436436    REAL,INTENT(OUT) :: var(var_size)
    437437    LOGICAL,OPTIONAL,INTENT(OUT) :: found
    438    
     438
    439439    LOGICAL :: tmp_found
    440440    INTEGER :: varid
    441441    INTEGER :: ierr
    442    
    443     IF (is_master) THEN
    444  
     442
     443    IF (is_master) THEN
     444
    445445      ierr=NF90_INQ_VARID(nid_start,var_name,varid)
    446      
     446
    447447      IF (ierr==NF90_NOERR) THEN
    448448        ierr=NF90_GET_VAR(nid_start,varid,var)
    … …  
    455455        tmp_found=.FALSE.
    456456      ENDIF
    457    
    458     ENDIF
    459    
     457
     458    ENDIF
     459
    460460    CALL bcast(tmp_found)
    461461
    … …  
    463463      CALL bcast(var)
    464464    ENDIF
    465    
     465
    466466    IF (PRESENT(found)) THEN
    467467      found=tmp_found
    … …  
    494494    INTEGER,INTENT(INOUT)       :: nid_restart
    495495    INTEGER                     :: ierr
    496    
    497     IF (is_master) THEN
    498      
     496
     497    IF (is_master) THEN
     498
    499499        ierr=NF90_CREATE(filename,IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), &
    500500                          nid_restart)
    … …  
    518518        CALL abort_physic("create_restartphy","Failed defining index",1)
    519519      ENDIF
    520      
     520
    521521      ierr=NF90_DEF_DIM(nid_restart,"physical_points",klon_glo,idim2)
    522522      IF (ierr/=NF90_NOERR) THEN
    … …  
    525525        CALL abort_physic("create_restartphy","Failed defining physical_points",1)
    526526      ENDIF
    527      
     527
    528528      ierr=NF90_DEF_DIM(nid_restart,"subsurface_layers",nsoilmx,idim3)
    529529      IF (ierr/=NF90_NOERR) THEN
    … …  
    532532        CALL abort_physic("create_restartphy","Failed defining subsurface_layers",1)
    533533      ENDIF
    534      
     534
    535535      ierr=NF90_DEF_DIM(nid_restart,"nlayer_plus_1",klevp1,idim4)
    536536      IF (ierr/=NF90_NOERR) THEN
    … …  
    539539        CALL abort_physic("create_restartphy","Failed defining nlayer_plus_1",1)
    540540      ENDIF
    541      
     541
    542542      if (nqtot>0) then
    543543        ! only define a tracer dimension if there are tracers
    … …  
    556556        CALL abort_physic("create_restartphy","Failed defining nlayer",1)
    557557      ENDIF
    558      
     558
    559559      ierr=NF90_DEF_DIM(nid_restart,"Time",NF90_UNLIMITED,idim7)
    560560      IF (ierr/=NF90_NOERR) THEN
    … …  
    577577        CALL abort_physic("create_restartphy","Failed defining descriptor",1)
    578578      ENDIF
    579      
     579
    580580      ierr=NF90_DEF_DIM(nid_restart,"description_size",ndscrpt,idim11)
    581581      IF (ierr/=NF90_NOERR) THEN
    … …  
    603603    INTEGER,INTENT(INOUT)       :: nid_restart
    604604    INTEGER                     :: ierr
    605    
     605
    606606    IF (is_master) THEN
    607607        ierr=NF90_OPEN(filename,NF90_WRITE,nid_restart)
    608608        IF (ierr/=NF90_NOERR) THEN
     609          if (ierr.eq.2) then ! file does not exist
     610            call create_restartphy(filename,nid_restart)
     611            return
     612          endif
    609613          write(*,*)'open_restartphy: problem opening file '//trim(filename)
    610614          write(*,*)trim(nf90_strerror(ierr))
    … …  
    625629      ierr = NF90_CLOSE (nid_restart)
    626630    ENDIF
    627  
     631
    628632  END SUBROUTINE close_restartphy
    629633
    … …  
    636640  REAL,INTENT(IN)                :: field(:)
    637641  REAL,OPTIONAL,INTENT(IN)       :: time
    638  
     642
    639643  IF (present(time)) THEN
    640644    ! if timeindex is present, it is a time-dependent variable
    … …  
    643647    CALL put_field_rgen(nid_restart,field_name,title,field,1)
    644648  ENDIF
    645  
     649
    646650  END SUBROUTINE put_field_r1
    647651
    … …  
    654658  REAL,INTENT(IN)                :: field(:,:)
    655659  REAL,OPTIONAL,INTENT(IN)       :: time
    656  
     660
    657661  IF (present(time)) THEN
    658662    ! if timeindex is present, it is a time-dependent variable
    … …  
    661665    CALL put_field_rgen(nid_restart,field_name,title,field,size(field,2))
    662666  ENDIF
    663  
     667
    664668  END SUBROUTINE put_field_r2
    665669
    … …  
    672676  REAL,INTENT(IN)                :: field(:,:,:)
    673677  REAL,OPTIONAL,INTENT(IN)       :: time
    674  
     678
    675679  IF (present(time)) THEN
    676680    ! if timeindex is present, it is a time-dependent variable
    677681    CALL put_field_rgen(nid_restart,field_name,title,field,size(field,2)*size(field,3),&
    678682                        time)
    679   ELSE 
     683  ELSE
    680684    CALL put_field_rgen(nid_restart,field_name,title,field,size(field,2)*size(field,3))
    681685  ENDIF
    682  
     686
    683687  END SUBROUTINE put_field_r3
    684  
     688
    685689  SUBROUTINE put_field_rgen(nid_restart,field_name,title,field,field_size,time)
    686690  USE netcdf, ONLY: NF90_REDEF, NF90_ENDDEF, NF90_DEF_VAR, NF90_PUT_ATT, &
    … …  
    702706  REAL,INTENT(IN)                :: field(klon,field_size)
    703707  REAL,OPTIONAL,INTENT(IN)       :: time
    704  
     708
    705709  REAL :: field_glo(klon_glo,field_size)
    706710  REAL :: field_glo_tmp(klon_glo,field_size)
    707711  INTEGER :: ind_cell_glo_glo(klon_glo) ! cell indexes on global grid
    708  
     712
    709713  INTEGER                        :: ierr
    710714  INTEGER                        :: nvarid
    711715  INTEGER                        :: idim
    712716  INTEGER :: i
    713  
     717
    714718    ! gather indexes on global grid
    715719    CALL gather(ind_cell_glo,ind_cell_glo_glo)
    716720    ! gather field on master
    717721    CALL gather(field,field_glo_tmp)
    718    
     722
    719723    IF (is_master) THEN
    720724      ! reorder columns
    … …  
    722726        field_glo(ind_cell_glo_glo(i),:)=field_glo_tmp(i,:)
    723727      ENDDO
    724      
     728
    725729      IF (field_size==1) THEN
    726730        ! input is a 1D "surface field" array
    … …  
    950954
    951955    ENDIF ! of IF (is_master)
    952    
    953   END SUBROUTINE put_field_rgen 
    954  
     956
     957  END SUBROUTINE put_field_rgen
     958
    955959  SUBROUTINE put_var_r0(nid_restart,var_name,title,var)
    956960  ! Put a scalar in file
    … …  
    961965     REAL,INTENT(IN)             :: var
    962966     REAL                        :: varin(1)
    963      
     967
    964968     varin(1)=var
    965      
     969
    966970     CALL put_var_rgen(nid_restart,var_name,title,varin,size(varin))
    967971
    … …  
    976980     CHARACTER(LEN=*),INTENT(IN) :: title
    977981     REAL,INTENT(IN)             :: var(:)
    978      
     982
    979983     CALL put_var_rgen(nid_restart,var_name,title,var,size(var))
    980984
    981985  END SUBROUTINE put_var_r1
    982  
     986
    983987  SUBROUTINE put_var_r2(nid_restart,var_name,title,var)
    984988  ! Put a 2D field in file
    … …  
    988992     CHARACTER(LEN=*),INTENT(IN) :: title
    989993     REAL,INTENT(IN)             :: var(:,:)
    990      
     994
    991995     CALL put_var_rgen(nid_restart,var_name,title,var,size(var))
    992996
    993   END SUBROUTINE put_var_r2     
    994  
     997  END SUBROUTINE put_var_r2
     998
    995999  SUBROUTINE put_var_r3(nid_restart,var_name,title,var)
    9961000  ! Put a 3D field in file
    … …  
    10001004     CHARACTER(LEN=*),INTENT(IN) :: title
    10011005     REAL,INTENT(IN)             :: var(:,:,:)
    1002      
     1006
    10031007     CALL put_var_rgen(nid_restart,var_name,title,var,size(var))
    10041008
    … …  
    10201024     INTEGER,INTENT(IN)          :: var_size
    10211025     REAL,INTENT(IN)             :: var(var_size)
    1022      
     1026
    10231027     INTEGER :: ierr
    10241028     INTEGER :: nvarid
    … …  
    10261030     logical,save :: firsttime=.true.
    10271031!$OMP THREADPRIVATE(firsttime)
    1028          
     1032
    10291033    IF (is_master) THEN
    10301034
    … …  
    10431047          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
    10441048          ierr=NF90_ENDDEF(nid_restart)
    1045          
     1049
    10461050          firsttime=.false.
    10471051        endif
    … …  
    10691073        ! We know it is an  "mlayer" kind of 1D array
    10701074        idim1d=idim8
    1071       ELSE 
     1075      ELSE
    10721076        PRINT *, "put_var_rgen error : wrong dimension"
    10731077        write(*,*) "  var_size =",var_size
    … …  
    10961100      ENDIF
    10971101    ENDIF ! of IF (is_master)
    1098    
    1099   END SUBROUTINE put_var_rgen     
     1102
     1103  END SUBROUTINE put_var_rgen
    11001104
    11011105  SUBROUTINE put_var_c1(nid_restart,var_name,title,var)
    … …  
    11261130        idim1d_1=idim11
    11271131        idim1d_2=idim10
    1128       ELSE 
     1132      ELSE
    11291133        PRINT *, "put_var_cgen error : wrong dimension"
    11301134        write(*,*) "  var_size =",var_size
    … …  
    11661170  !  USE slab_ice_h, only: noceanmx
    11671171    USE ocean_slab_mod, ONLY: nslay
    1168  
     1172
    11691173    IMPLICIT NONE
    11701174      CHARACTER(LEN=*),INTENT(IN) :: filename
    11711175      INTEGER,INTENT(INOUT)       :: nid_restart
    11721176      INTEGER                     :: ierr
    1173      
     1177
    11741178      IF (is_master) THEN
    1175        
     1179
    11761180          ierr=NF90_CREATE(filename,IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), &
    11771181                            nid_restart)
    … …  
    11811185            CALL abort_physic("create_restart1D","Failed creating file",1)
    11821186          ENDIF
    1183  
     1187
    11841188        ierr=NF90_PUT_ATT(nid_restart,NF90_GLOBAL,"title",&
    11851189                          "Physics start file")
    … …  
    11881192          write(*,*)trim(nf90_strerror(ierr))
    11891193        ENDIF
    1190        
     1194
    11911195        ierr=NF90_DEF_DIM(nid_restart,"physical_points",klon_glo,idim2)
    11921196        IF (ierr/=NF90_NOERR) THEN
    … …  
    11951199          CALL abort_physic("create_restart1D","Failed defining physical_points",1)
    11961200        ENDIF
    1197  
     1201
    11981202        ierr=NF90_DEF_DIM(nid_restart,"nlayer",klev,idim6)
    11991203        IF (ierr/=NF90_NOERR) THEN
    … …  
    12021206          CALL abort_physic("create_restart1D","Failed defining nlayer",1)
    12031207        ENDIF
    1204  
     1208
    12051209        ierr=NF90_ENDDEF(nid_restart)
    12061210        IF (ierr/=NF90_NOERR) THEN
    … …  
    12101214        ENDIF
    12111215      ENDIF
    1212  
     1216
    12131217    END SUBROUTINE create_restart1D
    12141218
Note: See TracChangeset for help on using the changeset viewer.