Changeset 1359 for trunk/NEMO/OPA_SRC/IOM/iom.F90

Timestamp:

2009-03-31T14:36:28+02:00 (15 years ago)

Author:

smasson

Message:

first implementation of iom_put, see ticket:387

File:

• trunk/NEMO/OPA_SRC/IOM/iom.F90 (modified) (6 diffs)

trunk/NEMO/OPA_SRC/IOM/iom.F90

@@ -26 +26 @@
    USE iom_rstdimg     ! restarts access direct format "dimg" style...
 
+#if defined key_ioserver
+   USE mod_event_client
+# endif
+
    IMPLICIT NONE
    PUBLIC   !   must be public to be able to access iom_def through iom
    
-   PUBLIC iom_open, iom_close, iom_varid, iom_get, iom_gettime, iom_rstput
+   PUBLIC iom_init, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put
 
    PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
    PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d
+   PRIVATE iom_p2d, iom_p3d
+#if defined key_ioserver
+   PRIVATE iom_init_chkcpp
+   PRIVATE set_grid
+# endif
 
    INTERFACE iom_get
@@ -40 +49 @@
       MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
    END INTERFACE
+  INTERFACE iom_put
+     MODULE PROCEDURE iom_p2d, iom_p3d
+  END INTERFACE
+#if defined key_ioserver
+   INTERFACE iom_setkt
+      MODULE PROCEDURE event__set_timestep
+   END INTERFACE
+# endif
 
    !!----------------------------------------------------------------------
@@ -48 +65 @@
 
 CONTAINS
+
+   SUBROUTINE iom_init( pjulian )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::  pjulian   !: julian day at nit000 = 0
+#if defined key_ioserver
+      !!----------------------------------------------------------------------
+      ! read the xml file
+      CALL event__parse_xml_file( 'iodef.xml' )   ! <- to get from the nameliste (namrun)...
+
+      ! calendar parameters
+      CALL event__set_time_parameters( nit000 - 1, pjulian, rdt )
+
+      ! horizontal grid definition
+      CALL set_grid( "grid_T", glamt, gphit )
+      CALL set_grid( "grid_U", glamu, gphiu )
+      CALL set_grid( "grid_V", glamv, gphiv )
+      CALL set_grid( "grid_W", glamt, gphit )
+
+      ! vertical grid definition
+      CALL event__set_vert_axis( "deptht", gdept_0 )
+      CALL event__set_vert_axis( "depthu", gdept_0 )
+      CALL event__set_vert_axis( "depthv", gdept_0 )
+      CALL event__set_vert_axis( "depthw", gdepw_0 )
+
+      ! consistency regarding CPP keys...
+      CALL iom_init_chkcpp
+
+      ! end file definition
+      CALL event__close_io_definition
+#endif
+
+   END SUBROUTINE iom_init
+
 
    SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof )
@@ -92 +147 @@
       ! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0
       ! (could be done when defining iom_file in f95 but not in f90)
-      IF( iom_init == 0 ) THEN
+      IF( iom_open_init == 0 ) THEN
          iom_file(:)%nfid = 0
-         iom_init = 1
+         iom_open_init = 1
       ENDIF
       ! do we read or write the file?
@@ -244 +299 @@
          i_s = 1
          i_e = jpmax_files
+#if defined key_ioserver
+         CALL event__stop_ioserver
+#endif
       ENDIF
 
@@ -822 +880 @@
       ENDIF
    END SUBROUTINE iom_rp3d
+
+
    !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_rstput
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_p2d( cdname, pfield2d )
+      CHARACTER(LEN=*)            , INTENT(in) ::   cdname
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pfield2d
+#if defined key_ioserver
+      CALL event__write_field2D( cdname, pfield2d(nldi:nlei, nldj:nlej) )
+#endif
+   END SUBROUTINE iom_p2d
+
+   SUBROUTINE iom_p3d( cdname, pfield3d )
+      CHARACTER(LEN=*)                , INTENT(in) ::   cdname
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   pfield3d
+#if defined key_ioserver
+      CALL event__write_field3D( cdname, pfield3d(nldi:nlei, nldj:nlej, :) )
+#endif
+   END SUBROUTINE iom_p3d
+   !!----------------------------------------------------------------------
+
+
+#if defined key_ioserver
+
+   SUBROUTINE set_grid( cdname, plon, plat )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)            , INTENT(in) ::   cdname
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plon
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
+
+      CALL event__set_grid_dimension( cdname, jpiglo, jpjglo)
+      CALL event__set_grid_domain( cdname, nlei-nldi+1, nlej-nldj+1, nimpp+nldi-1, njmpp+nldj-1, &
+         &                         plon(nldi:nlei, nldj:nlej), plat(nldi:nlei, nldj:nlej) )
+      CALL event__set_grid_type_nemo( cdname )
+
+   END SUBROUTINE set_grid
+
+
+   SUBROUTINE iom_init_chkcpp
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE    ***
+      !!
+      !! ** Purpose :  
+      !!---------------------------------------------------------------------
+      USE zdfddm, ONLY :   lk_zdfddm      ! vertical  physics: double diffusion
+      
+#if defined key_dynspg_rl
+      CALL event__disable_field( "sossheig" )
+#else
+      CALL event__disable_field( "sobarstf" )
+#endif
+
+      !!#if ! ( ! defined key_dynspg_rl && defined key_ice_lim)
+      !!        CALL disable_field( "iowaflup" )
+      !!         CALL disable_field( "sowaflep" )
+      !!#endif
+
+#if ! defined key_coupled
+      CALL event__enable_field( "sohefldp" )
+      CALL event__enable_field( "sowafldp" )
+      CALL event__enable_field( "sosafldp" )
+#endif
+
+#if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 ) 
+      CALL event__enable_field( "sohefldp" )
+      CALL event__enable_field( "sowafldp" )
+      CALL event__enable_field( "sosafldp" )
+#endif
+
+#if ! defined key_diaspr
+      CALL event__disable_field( "sosurfps" )
+#endif
+
+#if ! defined key_diahth
+      CALL event__disable_field( "sothedep" )
+      CALL event__disable_field( "so20chgt" )
+      CALL event__disable_field( "so28chgt" )
+      CALL event__disable_field( "sohtc300" )
+#endif
+
+#if defined key_coupled 
+# if defined key_lim3
+      Must be adapted to LIM3
+# else
+      CALL event__enable_field( "soicetem" )
+      CALL event__enable_field( "soicealb" )
+# endif 
+#endif 
+
+#if ! defined key_diaeiv
+      CALL event__disable_field( "vozoeivu" )
+      CALL event__disable_field( "vomeeivv" )
+      CALL event__disable_field( "voveeivw" )
+#endif
+
+#if ! defined key_dynspg_rl
+      CALL event__disable_field( "sozospgx" )
+      CALL event__disable_field( "somespgy" )
+#endif
+
+      IF( lk_zdfddm ) CALL event__enable_field( "voddmavs" )
+
+#if ! defined key_traldf_c2d
+      CALL event__disable_field( "soleahtw" )
+#endif
+
+#if ! defined key_traldf_eiv 
+      CALL event__disable_field( "soleaeiw" )
+#endif
+
+   END SUBROUTINE iom_init_chkcpp
+
+#else
+
+   SUBROUTINE iom_setkt( kt )
+      INTEGER, INTENT(in   )::   kt 
+   END SUBROUTINE iom_setkt
+
+#endif