Index: trunk/LMDZ.PLUTO/changelog.txt =================================================================== --- trunk/LMDZ.PLUTO/changelog.txt (revision 3708) +++ trunk/LMDZ.PLUTO/changelog.txt (revision 3709) @@ -1857,2 +1857,8 @@ Updated files are put in "deftank/dynamico" for now. +== 02/04/2025 == EM +Add reindexing of columns when reading/writing (re)startfi files. This is not +necessary with the lon-lat (LMDZ.COMMON) dynamical core, but required when +using DYNAMICO (where correspondance between dynamics and physics column +indexes changes with number of computing cores). + Index: trunk/LMDZ.PLUTO/libf/phypluto/iostart.F90 =================================================================== --- trunk/LMDZ.PLUTO/libf/phypluto/iostart.F90 (revision 3708) +++ trunk/LMDZ.PLUTO/libf/phypluto/iostart.F90 (revision 3709) @@ -56,5 +56,5 @@ write(*,*)'open_startphy: problem opening file '//trim(filename) write(*,*)trim(nf90_strerror(ierr)) - CALL ABORT + CALL abort_physic("open_startphy","Failed opening file",1) ENDIF ENDIF @@ -120,5 +120,5 @@ //trim(field_name) write(*,*)trim(nf90_strerror(ierr)) - CALL ABORT + CALL abort_physic("inquire_field_ndims","Failed geting ndims",1) ENDIF ENDIF @@ -171,5 +171,5 @@ //trim(field_name) write(*,*)trim(nf90_strerror(ierr)) - CALL ABORT + CALL abort_physic("inquire_dimension_length","Failed geting dim length",1) ENDIF ENDIF @@ -269,20 +269,27 @@ SUBROUTINE Get_field_rgen(field_name,field,field_size, & corners,edges,found) - USE netcdf - USE dimphy - USE mod_grid_phy_lmdz - USE mod_phys_lmdz_para - IMPLICIT NONE - CHARACTER(LEN=*) :: Field_name - INTEGER :: field_size - REAL :: field(klon,field_size) + USE netcdf, ONLY: NF90_INQ_VARID, NF90_GET_VAR, NF90_NOERR + USE dimphy, ONLY: klon ! number of columns on local grid + USE geometry_mod, ONLY: ind_cell_glo + USE mod_grid_phy_lmdz, ONLY: klon_glo ! number of columns on global grid + USE mod_phys_lmdz_para, ONLY: is_master, bcast, scatter, gather + IMPLICIT NONE + CHARACTER(LEN=*),INTENT(IN) :: Field_name + INTEGER,INTENT(IN) :: field_size + REAL,INTENT(OUT) :: field(klon,field_size) INTEGER,INTENT(IN) :: corners(4) INTEGER,INTENT(IN) :: edges(4) - LOGICAL,OPTIONAL :: found - - REAL :: field_glo(klon_glo,field_size) + LOGICAL,OPTIONAL,INTENT(OUT) :: found + + REAL :: field_glo(klon_glo,field_size) ! field on global grid + REAL :: field_glo_tmp(klon_glo,field_size) + INTEGER :: ind_cell_glo_glo(klon_glo) ! cell indexes on global grid + LOGICAL :: tmp_found INTEGER :: varid - INTEGER :: ierr + INTEGER :: ierr, i + + ! gather columns indexes on global grid + CALL gather(ind_cell_glo,ind_cell_glo_glo) IF (is_master) THEN @@ -291,5 +298,5 @@ IF (ierr==NF90_NOERR) THEN - CALL body(field_glo) + CALL body(field_glo_tmp) tmp_found=.TRUE. ELSE @@ -297,9 +304,15 @@ ENDIF - ENDIF + ENDIF ! of IF (is_master) CALL bcast(tmp_found) IF (tmp_found) THEN + IF (is_master) THEN + ! reorder columns according to ind_cell_glo(:) indexes + DO i=1,klon_glo + field_glo(i,:)=field_glo_tmp(ind_cell_glo_glo(i),:) + ENDDO + ENDIF CALL scatter(field_glo,field) ENDIF @@ -310,5 +323,5 @@ IF (.NOT. tmp_found) THEN PRINT*, 'get_field_rgen: Field <'//field_name//'> not found' - CALL abort + CALL abort_physic("get_field_rgen","Field not found",1) ENDIF ENDIF @@ -324,17 +337,5 @@ PRINT*, 'get_field_rgen: Failed reading <'//field_name//'>' -! IF (field_name=='CLWCON' .OR. field_name=='RNEBCON' .OR. field_name=='RATQS') THEN -! ! Essaye de lire le variable sur surface uniqument, comme fait avant -! field_glo(:)=0. -! ierr=NF90_GET_VAR(nid_start,varid,field_glo(1:klon_glo)) -! IF (ierr/=NF90_NOERR) THEN -! PRINT*, 'phyetat0: Lecture echouee aussi en 2D pour <'//field_name//'>' -! CALL abort -! ELSE -! PRINT*, 'phyetat0: La variable <'//field_name//'> lu sur surface seulement'!, selon ancien format, le reste mis a zero' -! END IF -! ELSE - CALL abort -! ENDIF + CALL abort_physic("get_field_rgen","Failed to read field",1) ENDIF @@ -408,8 +409,6 @@ SUBROUTINE Get_var_rgen(var_name,var,var_size,found) - USE netcdf - USE dimphy - USE mod_grid_phy_lmdz - USE mod_phys_lmdz_para + USE netcdf, ONLY: NF90_INQ_VARID, NF90_GET_VAR, NF90_NOERR + USE mod_phys_lmdz_para, ONLY: is_master, bcast IMPLICIT NONE CHARACTER(LEN=*) :: var_name @@ -422,5 +421,5 @@ INTEGER :: ierr - IF (is_mpi_root .AND. is_omp_root) THEN + IF (is_master) THEN ierr=NF90_INQ_VARID(nid_start,var_name,varid) @@ -430,5 +429,5 @@ IF (ierr/=NF90_NOERR) THEN PRINT*, 'phyetat0: Failed loading <'//trim(var_name)//'>' - CALL abort + CALL abort_physic("get_var_rgen","Failed to read variable",1) ENDIF tmp_found=.TRUE. @@ -450,5 +449,5 @@ IF (.NOT. tmp_found) THEN PRINT*, 'phyetat0: Variable <'//trim(var_name)//'> not found' - CALL abort + CALL abort_physic("get_var_rgen","Variable not found",1) ENDIF ENDIF @@ -486,5 +485,5 @@ write(*,*)'open_restartphy: problem creating file '//trim(filename) write(*,*)trim(nf90_strerror(ierr)) - CALL ABORT + CALL abort_physic("open_restartphy","Failed to create file",1) ENDIF already_created=.true. @@ -495,5 +494,5 @@ write(*,*)'open_restartphy: problem opening file '//trim(filename) write(*,*)trim(nf90_strerror(ierr)) - CALL ABORT + CALL abort_physic("open_restartphy","Failed to open file",1) ENDIF return @@ -511,5 +510,5 @@ write(*,*)'open_restartphy: problem defining index dimension ' write(*,*)trim(nf90_strerror(ierr)) - CALL ABORT + CALL abort_physic("open_restartphy","Failed defining index dim",1) ENDIF @@ -518,5 +517,5 @@ write(*,*)'open_restartphy: problem defining physical_points dimension ' write(*,*)trim(nf90_strerror(ierr)) - CALL ABORT + CALL abort_physic("open_restartphy","Failed defining physical_points dim",1) ENDIF @@ -525,5 +524,5 @@ write(*,*)'open_restartphy: problem defining subsurface_layers dimension ' write(*,*)trim(nf90_strerror(ierr)) - CALL ABORT + CALL abort_physic("open_restartphy","Failed defining subsurface_layers dim",1) ENDIF @@ -532,5 +531,5 @@ write(*,*)'open_restartphy: problem defining nlayer_plus_1 dimension ' write(*,*)trim(nf90_strerror(ierr)) - CALL ABORT + CALL abort_physic("open_restartphy","Failed defining nlayer_plus_1 dim",1) ENDIF @@ -541,5 +540,5 @@ write(*,*)'open_restartphy: problem defining number_of_advected_fields dimension ' write(*,*)trim(nf90_strerror(ierr)) - CALL ABORT + CALL abort_physic("open_restartphy","Failed defining number_of_advected_fields dim",1) ENDIF endif @@ -549,5 +548,5 @@ write(*,*)'open_restartphy: problem defining nlayer dimension ' write(*,*)trim(nf90_strerror(ierr)) - CALL ABORT + CALL abort_physic("open_restartphy","Failed defining nlayer dim",1) ENDIF @@ -556,14 +555,6 @@ write(*,*)'open_restartphy: problem defining Time dimension ' write(*,*)trim(nf90_strerror(ierr)) - CALL ABORT - ENDIF - - ! ierr=NF90_DEF_DIM(nid_restart,"ocean_layers",nslay,idim8) - ! IF (ierr/=NF90_NOERR) THEN - ! write(*,*)'open_restartphy: problem defining oceanic layer dimension ' - ! write(*,*)trim(nf90_strerror(ierr)) - ! CALL ABORT - ! ENDIF - + CALL abort_physic("open_restartphy","Failed defining Time dim",1) + ENDIF ierr=NF90_ENDDEF(nid_restart) @@ -571,5 +562,5 @@ write(*,*)'open_restartphy: problem ending definition mode ' write(*,*)trim(nf90_strerror(ierr)) - CALL ABORT + CALL abort_physic("open_restartphy","Failed ending definition mode",1) ENDIF ENDIF @@ -642,11 +633,12 @@ SUBROUTINE put_field_rgen(field_name,title,field,field_size,time) - USE netcdf - USE dimphy + USE netcdf, ONLY: NF90_REDEF, NF90_ENDDEF, NF90_DEF_VAR, NF90_PUT_ATT, & + NF90_INQ_VARID, NF90_PUT_VAR, NF90_STRERROR, & + NF90_NOERR, NF90_FLOAT, NF90_DOUBLE + USE dimphy, ONLY: klon, klev, klevp1 USE comsoil_h, only: nsoilmx - USE mod_grid_phy_lmdz - USE mod_phys_lmdz_para -! USE slab_ice_h, only: noceanmx - ! USE ocean_slab_mod, ONLY: nslay + USE mod_grid_phy_lmdz, ONLY: klon_glo + USE mod_phys_lmdz_para, ONLY: is_master, gather + USE geometry_mod, ONLY: ind_cell_glo IMPLICIT NONE @@ -657,13 +649,24 @@ REAL,OPTIONAL,INTENT(IN) :: time - REAL :: field_glo(klon_glo,field_size) + REAL :: field_glo(klon_glo,field_size) + REAL :: field_glo_tmp(klon_glo,field_size) + INTEGER :: ind_cell_glo_glo(klon_glo) ! cell indexes on global grid + INTEGER :: ierr INTEGER :: nvarid INTEGER :: idim + INTEGER :: i - CALL gather(field,field_glo) - - IF (is_master) THEN - + ! gather indexes on global grid + CALL gather(ind_cell_glo,ind_cell_glo_glo) + ! gather field on master + CALL gather(field,field_glo_tmp) + + IF (is_master) THEN + ! reorder columns + DO i=1,klon_glo + field_glo(ind_cell_glo_glo(i),:)=field_glo_tmp(i,:) + ENDDO + IF (field_size==1) THEN ! input is a 1D "surface field" array @@ -882,5 +885,5 @@ PRINT *, "Error phyredem(put_field_rgen) : wrong dimension for ",trim(field_name) write(*,*) " field_size =",field_size - CALL ABORT + CALL abort_physic("put_field_rgen","Wrong field dimensions",1) ENDIF @@ -889,5 +892,5 @@ write(*,*) " Error phyredem(put_field_rgen) : failed writing ",trim(field_name) write(*,*)trim(nf90_strerror(ierr)) - call abort + call abort_physic("put_field_rgen","Failed writing variable",1) endif @@ -995,5 +998,5 @@ write(*,*)'put_var_rgen: problem writing Time' write(*,*)trim(nf90_strerror(ierr)) - CALL ABORT + CALL abort_physic("put_var_rgen","Failed writing Time",1) ENDIF return ! nothing left to do @@ -1010,5 +1013,5 @@ PRINT *, "put_var_rgen error : wrong dimension" write(*,*) " var_size =",var_size - CALL abort + CALL abort_physic("put_var_rgen","Wrong field dimensions",1) ENDIF ! of IF (var_size==length) THEN @@ -1031,5 +1034,5 @@ write(*,*)'put_var_rgen: problem writing '//trim(var_name) write(*,*)trim(nf90_strerror(ierr)) - CALL ABORT + CALL abort_physic("put_var_rgen","Failed writing variable",1) ENDIF ENDIF ! of IF (is_master)