Ignore:
Timestamp:
Nov 21, 2019, 4:43:45 PM (4 years ago)
Author:
lguez
Message:

Merge revisions 3427:3600 of trunk into branch Ocean_skin

Location:
LMDZ6/branches/Ocean_skin
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Ocean_skin

  • LMDZ6/branches/Ocean_skin/libf/phylmd/iostart.F90

    r3401 r3605  
    2525
    2626    PUBLIC get_field,get_var,put_field,put_var
    27     PUBLIC Open_startphy,close_startphy,open_restartphy,close_restartphy
     27    PUBLIC Open_startphy,close_startphy,open_restartphy,close_restartphy, enddef_restartphy
    2828   
    2929CONTAINS
    … …  
    117117  USE netcdf
    118118  USE dimphy
     119  USE geometry_mod
    119120  USE mod_grid_phy_lmdz
    120121  USE mod_phys_lmdz_para
    … …  
    125126    LOGICAL,OPTIONAL :: found
    126127   
    127     REAL    :: field_glo(klon_glo,field_size)
     128    REAL,ALLOCATABLE    :: field_glo(:,:)
     129    REAL,ALLOCATABLE    :: field_glo_tmp(:,:)
     130    INTEGER,ALLOCATABLE :: ind_cell_glo_glo(:)
    128131    LOGICAL :: tmp_found
    129132    INTEGER :: varid
    130     INTEGER :: ierr
    131    
    132     IF (is_mpi_root .AND. is_omp_root) THEN
     133    INTEGER :: ierr,i
     134
     135    IF (is_master) THEN
     136      ALLOCATE(ind_cell_glo_glo(klon_glo))
     137      ALLOCATE(field_glo(klon_glo,field_size))
     138      ALLOCATE(field_glo_tmp(klon_glo,field_size))
     139    ELSE
     140      ALLOCATE(ind_cell_glo_glo(0))
     141      ALLOCATE(field_glo(0,0))
     142    ENDIF
     143   
     144    CALL gather(ind_cell_glo,ind_cell_glo_glo)
     145   
     146    IF (is_master) THEN
    133147 
    134148      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
    135149     
    136150      IF (ierr==NF90_NOERR) THEN
    137         CALL body(field_glo)
     151        CALL body(field_glo_tmp)
    138152        tmp_found=.TRUE.
    139153      ELSE
    … …  
    146160
    147161    IF (tmp_found) THEN
     162      IF (is_master) THEN 
     163        DO i=1,klon_glo
     164         field_glo(i,:)=field_glo_tmp(ind_cell_glo_glo(i),:)
     165        ENDDO
     166      ENDIF
    148167      CALL scatter(field_glo,field)
    149168    ENDIF
    … …  
    307326      ierr = NF90_DEF_DIM (nid_restart, "horizon_klevp1", klon_glo*klevp1, idim4)
    308327
    309       ierr = NF90_ENDDEF(nid_restart)
     328!      ierr = NF90_ENDDEF(nid_restart)
    310329    ENDIF
    311330
    312331  END SUBROUTINE open_restartphy
    313332 
     333  SUBROUTINE enddef_restartphy
     334  USE netcdf
     335  USE mod_phys_lmdz_para
     336  IMPLICIT NONE
     337    INTEGER          :: ierr
     338
     339    IF (is_master) ierr = NF90_ENDDEF(nid_restart)
     340 
     341  END SUBROUTINE enddef_restartphy
     342
    314343  SUBROUTINE close_restartphy
    315344  USE netcdf
    … …  
    318347    INTEGER          :: ierr
    319348
    320     IF (is_mpi_root .AND. is_omp_root) THEN
    321       ierr = NF90_CLOSE (nid_restart)
    322     ENDIF
     349    IF (is_master) ierr = NF90_CLOSE (nid_restart)
    323350 
    324351  END SUBROUTINE close_restartphy
    325352
    326353 
    327   SUBROUTINE put_field_r1(field_name,title,field)
    328   IMPLICIT NONE
     354  SUBROUTINE put_field_r1(pass, field_name,title,field)
     355  IMPLICIT NONE
     356  INTEGER, INTENT(IN)            :: pass
    329357  CHARACTER(LEN=*),INTENT(IN)    :: field_name
    330358  CHARACTER(LEN=*),INTENT(IN)    :: title
    331359  REAL,INTENT(IN)                :: field(:)
    332  
    333     CALL put_field_rgen(field_name,title,field,1)
     360    CALL put_field_rgen(pass, field_name,title,field,1)
    334361 
    335362  END SUBROUTINE put_field_r1
    336363
    337   SUBROUTINE put_field_r2(field_name,title,field)
    338   IMPLICIT NONE
     364  SUBROUTINE put_field_r2(pass, field_name,title,field)
     365  IMPLICIT NONE
     366  INTEGER, INTENT(IN)            :: pass
    339367  CHARACTER(LEN=*),INTENT(IN)    :: field_name
    340368  CHARACTER(LEN=*),INTENT(IN)    :: title
    341369  REAL,INTENT(IN)                :: field(:,:)
    342370 
    343     CALL put_field_rgen(field_name,title,field,size(field,2))
     371    CALL put_field_rgen(pass, field_name,title,field,size(field,2))
    344372 
    345373  END SUBROUTINE put_field_r2
    346374
    347   SUBROUTINE put_field_r3(field_name,title,field)
    348   IMPLICIT NONE
     375  SUBROUTINE put_field_r3(pass, field_name,title,field)
     376  IMPLICIT NONE
     377  INTEGER, INTENT(IN)            :: pass
    349378  CHARACTER(LEN=*),INTENT(IN)    :: field_name
    350379  CHARACTER(LEN=*),INTENT(IN)    :: title
    351380  REAL,INTENT(IN)                :: field(:,:,:)
    352381 
    353     CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3))
     382    CALL put_field_rgen(pass, field_name,title,field,size(field,2)*size(field,3))
    354383 
    355384  END SUBROUTINE put_field_r3
    356385 
    357   SUBROUTINE put_field_rgen(field_name,title,field,field_size)
     386  SUBROUTINE put_field_rgen(pass, field_name,title,field,field_size)
    358387  USE netcdf
    359388  USE dimphy
     389  USE geometry_mod
    360390  USE mod_grid_phy_lmdz
    361391  USE mod_phys_lmdz_para
    362392  IMPLICIT NONE
     393  INTEGER, INTENT(IN)            :: pass
    363394  CHARACTER(LEN=*),INTENT(IN)    :: field_name
    364395  CHARACTER(LEN=*),INTENT(IN)    :: title
    … …  
    366397  REAL,INTENT(IN)                :: field(klon,field_size)
    367398 
    368   REAL                           :: field_glo(klon_glo,field_size)
    369   INTEGER                        :: ierr
     399!  REAL                           :: field_glo(klon_glo,field_size)
     400!  REAL                           :: field_glo_tmp(klon_glo,field_size)
     401  REAL ,ALLOCATABLE              :: field_glo(:,:)
     402  REAL ,ALLOCATABLE              :: field_glo_tmp(:,:)
     403  INTEGER,ALLOCATABLE            :: ind_cell_glo_glo(:)
     404!  INTEGER                        :: ind_cell_glo_glo(klon_glo)
     405  INTEGER                        :: ierr,i
    370406  INTEGER                        :: nvarid
    371407  INTEGER                        :: idim
    372408   
    373    
    374     CALL gather(field,field_glo)
    375    
    376     IF (is_mpi_root .AND. is_omp_root) THEN
     409! first pass : definition   
     410  IF (pass==1) THEN
     411   
     412    IF (is_master) THEN
    377413
    378414      IF (field_size==1) THEN
    … …  
    387423      ENDIF
    388424         
    389       ierr = NF90_REDEF (nid_restart)
     425!      ierr = NF90_REDEF (nid_restart)
    390426#ifdef NC_DOUBLE
    391427      ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_DOUBLE,(/ idim /),nvarid)
    … …  
    394430#endif
    395431      IF (LEN_TRIM(title) > 0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
    396       ierr = NF90_ENDDEF(nid_restart)
    397       ierr = NF90_PUT_VAR(nid_restart,nvarid,RESHAPE(field_glo,(/klon_glo*field_size/)))
    398     ENDIF
    399    
    400    END SUBROUTINE put_field_rgen 
    401  
    402    SUBROUTINE put_var_r0(var_name,title,var)
     432!      ierr = NF90_ENDDEF(nid_restart)
     433     ENDIF
     434
     435! second pass : write     
     436   ELSE IF (pass==2) THEN
     437   
     438     IF (is_master) THEN
     439       ALLOCATE(ind_cell_glo_glo(klon_glo))
     440       ALLOCATE(field_glo(klon_glo,field_size))
     441       ALLOCATE(field_glo_tmp(klon_glo,field_size))
     442     ELSE
     443       ALLOCATE(ind_cell_glo_glo(0))
     444       ALLOCATE(field_glo_tmp(0,0))
     445     ENDIF
     446     
     447     CALL gather(ind_cell_glo,ind_cell_glo_glo)
     448
     449     CALL gather(field,field_glo_tmp)
     450   
     451     IF (is_master) THEN
     452
     453       DO i=1,klon_glo
     454         field_glo(ind_cell_glo_glo(i),:)=field_glo_tmp(i,:)
     455       ENDDO
     456
     457       ierr = NF90_INQ_VARID(nid_restart, field_name, nvarid)
     458       ierr = NF90_PUT_VAR(nid_restart,nvarid,RESHAPE(field_glo,(/klon_glo*field_size/)))
     459      ENDIF
     460   ENDIF
     461   
     462 END SUBROUTINE put_field_rgen 
     463 
     464
     465 SUBROUTINE put_var_r0(pass, var_name,title,var)
    403466   IMPLICIT NONE
     467     INTEGER, INTENT(IN)            :: pass
    404468     CHARACTER(LEN=*),INTENT(IN) :: var_name
    405469     CHARACTER(LEN=*),INTENT(IN) :: title
    … …  
    409473     varin(1)=var
    410474     
    411      CALL put_var_rgen(var_name,title,varin,size(varin))
     475     CALL put_var_rgen(pass, var_name,title,varin,size(varin))
    412476
    413477  END SUBROUTINE put_var_r0
    414478
    415479
    416    SUBROUTINE put_var_r1(var_name,title,var)
     480   SUBROUTINE put_var_r1(pass, var_name,title,var)
    417481   IMPLICIT NONE
     482     INTEGER, INTENT(IN)            :: pass
    418483     CHARACTER(LEN=*),INTENT(IN) :: var_name
    419484     CHARACTER(LEN=*),INTENT(IN) :: title
    420485     REAL,INTENT(IN)             :: var(:)
    421486     
    422      CALL put_var_rgen(var_name,title,var,size(var))
     487     CALL put_var_rgen(pass, var_name,title,var,size(var))
    423488
    424489  END SUBROUTINE put_var_r1
    425490 
    426   SUBROUTINE put_var_r2(var_name,title,var)
     491  SUBROUTINE put_var_r2(pass, var_name,title,var)
    427492   IMPLICIT NONE
     493     INTEGER, INTENT(IN)            :: pass
    428494     CHARACTER(LEN=*),INTENT(IN) :: var_name
    429495     CHARACTER(LEN=*),INTENT(IN) :: title
    430496     REAL,INTENT(IN)             :: var(:,:)
    431497     
    432      CALL put_var_rgen(var_name,title,var,size(var))
     498     CALL put_var_rgen(pass, var_name,title,var,size(var))
    433499
    434500  END SUBROUTINE put_var_r2     
    435501 
    436   SUBROUTINE put_var_r3(var_name,title,var)
     502  SUBROUTINE put_var_r3(pass, var_name,title,var)
    437503   IMPLICIT NONE
     504     INTEGER, INTENT(IN)            :: pass
    438505     CHARACTER(LEN=*),INTENT(IN) :: var_name
    439506     CHARACTER(LEN=*),INTENT(IN) :: title
    440507     REAL,INTENT(IN)             :: var(:,:,:)
    441508     
    442      CALL put_var_rgen(var_name,title,var,size(var))
     509     CALL put_var_rgen(pass, var_name,title,var,size(var))
    443510
    444511  END SUBROUTINE put_var_r3
    445512
    446   SUBROUTINE put_var_rgen(var_name,title,var,var_size)
     513  SUBROUTINE put_var_rgen(pass, var_name,title,var,var_size)
    447514  USE netcdf
    448515  USE dimphy
    449516  USE mod_phys_lmdz_para
    450517  IMPLICIT NONE
    451      CHARACTER(LEN=*),INTENT(IN) :: var_name
    452      CHARACTER(LEN=*),INTENT(IN) :: title
    453      INTEGER,INTENT(IN)          :: var_size
    454      REAL,INTENT(IN)             :: var(var_size)
    455      
    456      INTEGER :: ierr
    457      INTEGER :: nvarid
     518    INTEGER, INTENT(IN)         :: pass
     519    CHARACTER(LEN=*),INTENT(IN) :: var_name
     520    CHARACTER(LEN=*),INTENT(IN) :: title
     521    INTEGER,INTENT(IN)          :: var_size
     522    REAL,INTENT(IN)             :: var(var_size)
     523   
     524    INTEGER :: ierr
     525    INTEGER :: nvarid
    458526         
    459     IF (is_mpi_root .AND. is_omp_root) THEN
     527    IF (is_master) THEN
    460528
    461529      IF (var_size/=length) THEN
    … …  
    463531        call abort_physic("", "", 1)
    464532      ENDIF
    465      
    466       ierr = NF90_REDEF (nid_restart)
     533
     534     ! first pass : definition   
     535      IF (pass==1) THEN
     536       
     537!      ierr = NF90_REDEF (nid_restart)
    467538
    468539#ifdef NC_DOUBLE
    469       ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_DOUBLE,(/ idim1 /),nvarid)
     540        ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_DOUBLE,(/ idim1 /),nvarid)
    470541#else
    471       ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_FLOAT,(/ idim1 /),nvarid)
     542        ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_FLOAT,(/ idim1 /),nvarid)
    472543#endif
    473       IF (LEN_TRIM(title)>0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
    474       ierr = NF90_ENDDEF(nid_restart)
    475      
    476       ierr = NF90_PUT_VAR(nid_restart,nvarid,var)
    477 
     544        IF (LEN_TRIM(title)>0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
     545!      ierr = NF90_ENDDEF(nid_restart)
     546
     547    ! second pass : write     
     548      ELSE IF (pass==2) THEN
     549        ierr = NF90_INQ_VARID(nid_restart, var_name, nvarid)
     550        ierr = NF90_PUT_VAR(nid_restart,nvarid,var)
     551      ENDIF
    478552    ENDIF
    479553   
Note: See TracChangeset for help on using the changeset viewer.