Changeset 3709

Timestamp:

Apr 2, 2025, 4:00:26 PM (32 hours ago)

Author:

emillour

Message:

Pluto PCM:
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).
EM

Location:

trunk/LMDZ.PLUTO

Files:

• changelog.txt (modified) (1 diff)
• libf/phypluto/iostart.F90 (modified) (29 diffs)

trunk/LMDZ.PLUTO/changelog.txt

@@ -1857 +1857 @@
   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).
+

trunk/LMDZ.PLUTO/libf/phypluto/iostart.F90

@@ -56 +56 @@
         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 +120 @@
                   //trim(field_name)
         write(*,*)trim(nf90_strerror(ierr))
-        CALL ABORT
+        CALL abort_physic("inquire_field_ndims","Failed geting ndims",1)
       ENDIF
     ENDIF
@@ -171 +171 @@
                   //trim(field_name)
         write(*,*)trim(nf90_strerror(ierr))
-        CALL ABORT
+        CALL abort_physic("inquire_dimension_length","Failed geting dim length",1)
       ENDIF
     ENDIF
@@ -269 +269 @@
   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 +298 @@
       
       IF (ierr==NF90_NOERR) THEN
-        CALL body(field_glo)
+        CALL body(field_glo_tmp)
         tmp_found=.TRUE.
       ELSE
@@ -297 +304 @@
       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 +323 @@
       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 +337 @@
            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 +409 @@
 
   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 +421 @@
     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 +429 @@
         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 +449 @@
       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 +485 @@
           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 +494 @@
           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 +510 @@
         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 +517 @@
         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 +524 @@
         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 +531 @@
         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 +540 @@
           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 +548 @@
         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 +555 @@
         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 +562 @@
         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 +633 @@
   
   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 +649 @@
   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 +885 @@
         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 +892 @@
         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 +998 @@
           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 +1013 @@
         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 +1034 @@
         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)