Changeset 4152 for branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

Timestamp:

2013-11-05T12:59:53+01:00 (10 years ago)

Author:

cetlod

Message:

merge in dev_LOCEAN_2013 the 2nd development branch dev_r3940_CNRS4_IOCRS, see ticket #1169

File:

• branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90 (modified) (11 diffs)

branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

@@ -37 +37 @@
 # endif
    USE ioipsl, ONLY :  ju2ymds    ! for calendar
+   USE crs             ! Grid coarsening
 
    IMPLICIT NONE
@@ -47 +48 @@
 #endif
    PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put
-   PUBLIC iom_getatt
+   PUBLIC iom_getatt, iom_context_finalize
 
    PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
@@ -69 +70 @@
      MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d
   END INTERFACE
-#if defined key_iomput
-   INTERFACE iom_setkt
-      MODULE PROCEDURE xios_update_calendar
-   END INTERFACE
-# endif
 
    !!----------------------------------------------------------------------
@@ -83 +79 @@
 CONTAINS
 
-   SUBROUTINE iom_init
+   SUBROUTINE iom_init( cdname ) 
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE   ***
@@ -90 +86 @@
       !!
       !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in)  :: cdname
 #if defined key_iomput
       TYPE(xios_time)   :: dtime    = xios_time(0, 0, 0, 0, 0, 0)
@@ -97 +94 @@
       !!----------------------------------------------------------------------
 
-      clname = "nemo"
-      IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
+      clname = cdname
+      IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname)
       CALL xios_context_initialize(TRIM(clname), mpi_comm_opa)
-      CALL iom_swap
+      CALL iom_swap( cdname )
 
       ! calendar parameters
@@ -113 +110 @@
       ! horizontal grid definition
       CALL set_scalar
-      CALL set_grid( "T", glamt, gphit ) 
-      CALL set_grid( "U", glamu, gphiu )
-      CALL set_grid( "V", glamv, gphiv )
-      CALL set_grid( "W", glamt, gphit )
+
+      IF( TRIM(cdname) == "nemo" ) THEN  
+         CALL set_grid( "T", glamt, gphit ) 
+         CALL set_grid( "U", glamu, gphiu )
+         CALL set_grid( "V", glamv, gphiv )
+         CALL set_grid( "W", glamt, gphit )
+      ENDIF
+
+      IF( TRIM(cdname) == "nemo_crs" ) THEN  
+         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+         !
+         CALL set_grid( "T", glamt_crs, gphit_crs ) 
+         CALL set_grid( "U", glamu_crs, gphiu_crs ) 
+         CALL set_grid( "V", glamv_crs, gphiv_crs ) 
+         CALL set_grid( "W", glamt_crs, gphit_crs ) 
+          !
+         CALL dom_grid_glo   ! Return to parent grid domain
+      ENDIF
+
 
       ! vertical grid definition
@@ -141 +153 @@
 
 
-   SUBROUTINE iom_swap
+   SUBROUTINE iom_swap( cdname )
       !!---------------------------------------------------------------------
       !!                   ***  SUBROUTINE  iom_swap  ***
@@ -147 +159 @@
       !! ** Purpose :  swap context between different agrif grid for xmlio_server
       !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdname
 #if defined key_iomput
       TYPE(xios_context) :: nemo_hdl
 
-     IF( TRIM(Agrif_CFixed()) == '0' ) THEN
-        CALL xios_get_handle("nemo",nemo_hdl)
-     ELSE
-        CALL xios_get_handle(TRIM(Agrif_CFixed())//"_nemo",nemo_hdl)
-     ENDIF
-     CALL xios_set_current_context(nemo_hdl)
-
+      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
+        CALL xios_get_handle(TRIM(cdname),nemo_hdl)
+      ELSE
+        CALL xios_get_handle(TRIM(Agrif_CFixed())//"_"//TRIM(cdname),nemo_hdl)
+      ENDIF
+      !
+      CALL xios_set_current_context(nemo_hdl)
 #endif
+      !
    END SUBROUTINE iom_swap
 
@@ -1100 +1114 @@
       CALL xios_solve_inheritance()
    END SUBROUTINE iom_set_grid_attr
+
+   SUBROUTINE iom_setkt( kt, cdname )
+      INTEGER         , INTENT(in) ::   kt 
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      !     
+      CALL iom_swap( cdname )   ! swap to cdname context
+      CALL xios_update_calendar(kt)
+      IF( cdname /= "nemo" ) CALL iom_swap( "nemo" )   ! return back to nemo context
+      !
+   END SUBROUTINE iom_setkt
+
+   SUBROUTINE iom_context_finalize( cdname )
+      CHARACTER(LEN=*), INTENT(in) :: cdname
+      !     
+      CALL iom_swap( cdname )   ! swap to cdname context
+      CALL xios_context_finalize() ! finalize the context
+      IF( cdname /= "nemo" ) CALL iom_swap( "nemo" )   ! return back to nemo context
+      !
+   END SUBROUTINE iom_context_finalize
 
 
@@ -1424 +1457 @@
 #else
 
-   SUBROUTINE iom_setkt( kt )
-      INTEGER, INTENT(in   )::   kt 
-      IF( .FALSE. )   WRITE(numout,*) kt   ! useless test to avoid compilation warnings
+
+   SUBROUTINE iom_setkt( kt, cdname )
+      INTEGER         , INTENT(in)::   kt 
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      IF( .FALSE. )   WRITE(numout,*) kt, cdname   ! useless test to avoid compilation warnings
    END SUBROUTINE iom_setkt
+
+   SUBROUTINE iom_context_finalize( cdname )
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      IF( .FALSE. )   WRITE(numout,*)  cdname   ! useless test to avoid compilation warnings
+   END SUBROUTINE iom_context_finalize
 
 #endif