Changeset 7576 for branches/ORCHIDEE_2_2/ORCHIDEE/src_parallel/ioipsl_para.f90

Timestamp:

2022-04-14T10:01:23+02:00 (2 years ago)

Author:

josefine.ghattas

Message:

Integrate routing scheme "highres" developped by Jan Polcher, tested and integrated in ORCHIDEE_2_2 by Lucia Rinchiuso. This corresponds to the revision 7574 of perso/lucia.rinchiuso/myORCHIDEE_2_2_r7481. The developements of the routing scheme from branches/ORCHIDEE-ROUTING at revision 7545 are taken into account.

See also ticket #842

File:

• branches/ORCHIDEE_2_2/ORCHIDEE/src_parallel/ioipsl_para.f90 (modified) (4 diffs)

branches/ORCHIDEE_2_2/ORCHIDEE/src_parallel/ioipsl_para.f90

@@ -46 +46 @@
   USE mod_orchidee_para_var
   USE mod_orchidee_transfert_para
+  USE constantes_var, ONLY: val_exp
 !-
   IMPLICIT NONE
@@ -86 +87 @@
      MODULE PROCEDURE &
           restput_p_r3d, restput_p_r2d, restput_p_r1d, &
-          restput_p_opp_r2d, restput_p_opp_r1d
+          restput_p_opp_r2d, restput_p_opp_r1d, &
+          restput_p_nogrid_r_scal, restput_p_nogrid_i_scal
   END INTERFACE
 !-
@@ -98 +100 @@
   !! \n
   !_ ================================================================================================================================
- INTERFACE restget_p
+  INTERFACE restget_p
      MODULE PROCEDURE &
           restget_p_r3d, restget_p_r2d, restget_p_r1d, &
-          restget_p_opp_r2d, restget_p_opp_r1d
+          restget_p_opp_r2d, restget_p_opp_r1d, &
+          restget_p_nogrid_r_scal, restget_p_nogrid_i_scal
   END INTERFACE
 
@@ -971 +974 @@
   END SUBROUTINE histwrite_r3d_p
 
+  !!  =============================================================================================================================
+!! SUBROUTINE:   restput_p_nogrid_r_scal
+!!
+!>\BRIEF          save real scalar (non-grid) data into the restart file
+!!
+!! DESCRIPTION:  Need to be call by all process
+!!
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE restput_p_nogrid_r_scal (fid,vname_q,itau,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: itau
+    REAL :: var
+    !-----------------------------
+    REAL :: xtmp(1)
+
+    IF (is_root_prc) THEN
+       xtmp(1) = var
+       CALL restput (fid, vname_q, 1, 1, 1, itau, xtmp)
+    ENDIF
+
+  END SUBROUTINE restput_p_nogrid_r_scal
+
+  !!  =============================================================================================================================
+!! SUBROUTINE:   restput_p_nogrid_i_scal
+!!
+!>\BRIEF          save integer scalar (non-grid) data into the restart file
+!!
+!! DESCRIPTION:  Need to be call by all process
+!!
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE restput_p_nogrid_i_scal (fid,vname_q,itau,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: itau
+    INTEGER :: var
+    !-----------------------------
+    REAL :: xtmp(1)
+    REAL :: realvar
+
+    IF (is_root_prc) THEN
+       realvar = REAL(var,r_std)
+       xtmp(1) = realvar
+       CALL restput (fid, vname_q, 1, 1, 1, itau, xtmp)
+    ENDIF
+
+  END SUBROUTINE restput_p_nogrid_i_scal
+
+!!  =============================================================================================================================
+!! SUBROUTINE:   restget_p_nogrid_r_scal
+!!
+!>\BRIEF        Transform the data (real scalar) from the restart file onto the model grid
+!!
+!! DESCRIPTION: 
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE restget_p_nogrid_r_scal &
+  (fid,vname_q,itau,def_beha,def_val,var)
+!
+    IMPLICIT NONE
+!-
+    INTEGER, INTENT(in)             :: fid
+    CHARACTER(LEN=*), INTENT(in)    :: vname_q
+    INTEGER, INTENT(in)             :: itau
+    LOGICAL, INTENT(in)             :: def_beha
+    REAL, INTENT(in)                :: def_val
+    REAL, INTENT(out) :: var
+    !-------------------------
+    REAL, DIMENSION(1) :: tmp
+
+    tmp(1) = var
+    IF (is_root_prc) THEN
+       var = val_exp
+       CALL restget (fid, vname_q, 1 ,1  , 1, itau, def_beha, tmp)
+       var = tmp(1)
+       IF(var == val_exp) var = def_val
+    ENDIF
+    CALL bcast(var)
+
+  END SUBROUTINE restget_p_nogrid_r_scal
+
+  !!  =============================================================================================================================
+!! SUBROUTINE:   restget_p_nogrid_i_scal
+!!
+!>\BRIEF        Transform the data (integer scalar) from the restart file onto the model grid
+!!
+!! DESCRIPTION:
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE restget_p_nogrid_i_scal &
+  (fid,vname_q,itau,def_beha,def_val,varint)
+!
+    IMPLICIT NONE
+!-
+    INTEGER, INTENT(in)             :: fid
+    CHARACTER(LEN=*), INTENT(in)    :: vname_q
+    INTEGER, INTENT(in)             :: itau
+    LOGICAL, INTENT(in)             :: def_beha
+    REAL, INTENT(in)                :: def_val
+    INTEGER, INTENT(out) :: varint
+    !-------------------------
+    REAL :: tmp
+
+    CALL restget_p_nogrid_r_scal(fid, vname_q, itau, def_beha, def_val, tmp)
+    varint = INT(tmp)
+  END SUBROUTINE restget_p_nogrid_i_scal
+
 
 END MODULE ioipsl_para