New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 1450 for trunk/NEMO/OFF_SRC/IOM/iom.F90 – NEMO

Ignore:
Timestamp:
2009-05-15T16:12:12+02:00 (15 years ago)
Author:
cetlod
Message:

implementation of iom_put in TOP, see ticket:432

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OFF_SRC/IOM/iom.F90

    r1324 r1450  
    2626   USE iom_rstdimg     ! restarts access direct format "dimg" style... 
    2727 
     28#if defined key_iomput 
     29   USE mod_event_client 
     30# endif 
     31 
    2832   IMPLICIT NONE 
    2933   PUBLIC   !   must be public to be able to access iom_def through iom 
    3034    
    31    PUBLIC iom_open, iom_close, iom_varid, iom_get, iom_gettime, iom_rstput 
     35   PUBLIC iom_init, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 
    3236 
    3337   PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 
    3438   PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d 
     39   PRIVATE iom_p2d, iom_p3d 
     40#if defined key_iomput 
     41   PRIVATE iom_init_chkcpp 
     42   PRIVATE set_grid 
     43# endif 
    3544 
    3645   INTERFACE iom_get 
    … …  
    4049      MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 
    4150   END INTERFACE 
     51  INTERFACE iom_put 
     52     MODULE PROCEDURE iom_p2d, iom_p3d 
     53  END INTERFACE 
     54#if defined key_iomput 
     55   INTERFACE iom_setkt 
     56      MODULE PROCEDURE event__set_timestep 
     57   END INTERFACE 
     58# endif 
    4259 
    4360   !!---------------------------------------------------------------------- 
    … …  
    4966CONTAINS 
    5067 
    51    SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop ) 
     68   SUBROUTINE iom_init( pjulian ) 
     69      !!---------------------------------------------------------------------- 
     70      !!                     ***  ROUTINE   *** 
     71      !! 
     72      !! ** Purpose :    
     73      !! 
     74      !!---------------------------------------------------------------------- 
     75      REAL(wp), INTENT(in) ::  pjulian   !: julian day at nit000 = 0 
     76#if defined key_iomput 
     77      !!---------------------------------------------------------------------- 
     78      ! read the xml file 
     79      CALL event__parse_xml_file( 'iodef.xml' )   ! <- to get from the nameliste (namrun)... 
     80 
     81      ! calendar parameters 
     82      CALL event__set_time_parameters( nit000 - 1, pjulian, rdt ) 
     83 
     84      ! horizontal grid definition 
     85      CALL set_grid( "grid_T", glamt, gphit ) 
     86      CALL set_grid( "grid_U", glamu, gphiu ) 
     87      CALL set_grid( "grid_V", glamv, gphiv ) 
     88      CALL set_grid( "grid_W", glamt, gphit ) 
     89 
     90      ! vertical grid definition 
     91      CALL event__set_vert_axis( "deptht", gdept_0 ) 
     92      CALL event__set_vert_axis( "depthu", gdept_0 ) 
     93      CALL event__set_vert_axis( "depthv", gdept_0 ) 
     94      CALL event__set_vert_axis( "depthw", gdepw_0 ) 
     95 
     96      ! consistency regarding CPP keys... 
     97      CALL iom_init_chkcpp 
     98 
     99      ! end file definition 
     100      CALL event__close_io_definition 
     101#endif 
     102 
     103   END SUBROUTINE iom_init 
     104 
     105 
     106   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof ) 
    52107      !!--------------------------------------------------------------------- 
    53108      !!                   ***  SUBROUTINE  iom_open  *** 
    … …  
    61116      INTEGER         , INTENT(in   ), OPTIONAL ::   kiolib   ! library used to open the file (default = jpnf90)  
    62117      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.) 
     118      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 
    63119 
    64120      CHARACTER(LEN=100)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu] 
    … …  
    71127      LOGICAL               ::   llnoov    ! local definition to read overlap 
    72128      LOGICAL               ::   llstop    ! local definition of ldstop 
     129      LOGICAL               ::   lliof     ! local definition of ldiof 
    73130      INTEGER               ::   iolib     ! library do we use to open the file 
    74131      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits) 
    … …  
    85142      ! Initializations and control 
    86143      ! ============= 
     144      kiomid = -1 
    87145      clinfo = '                    iom_open ~~~  ' 
    88146      istop = nstop 
    89147      ! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0 
    90148      ! (could be done when defining iom_file in f95 but not in f90) 
    91       IF( iom_init == 0 ) THEN 
     149#if ! defined key_agrif 
     150      IF( iom_open_init == 0 ) THEN 
    92151         iom_file(:)%nfid = 0 
    93          iom_init = 1 
    94       ENDIF 
     152         iom_open_init = 1 
     153      ENDIF 
     154#else 
     155      IF( Agrif_Root() ) THEN 
     156         IF( iom_open_init == 0 ) THEN 
     157            iom_file(:)%nfid = 0 
     158            iom_open_init = 1 
     159         ENDIF 
     160      ENDIF 
     161#endif 
    95162      ! do we read or write the file? 
    96163      IF( PRESENT(ldwrt) ) THEN   ;   llwrt = ldwrt 
    … …  
    105172      ELSE                         ;   iolib = jpnf90 
    106173      ENDIF 
     174      ! are we using interpolation on the fly? 
     175      IF( PRESENT(ldiof) ) THEN   ;   lliof = ldiof 
     176      ELSE                        ;   lliof = .FALSE. 
     177      ENDIF 
    107178      ! do we read the overlap  
    108179      ! ugly patch SM+JMM+RB to overwrite global definition in some cases 
    109 #if ! defined key_agrif 
    110       llnoov = (jpni * jpnj ) == jpnij 
    111 #endif 
     180      llnoov = (jpni * jpnj ) == jpnij  
    112181      ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix) 
    113182      ! ============= 
    114183      clname   = trim(cdname) 
    115184#if defined key_agrif 
    116       IF ( .NOT. Agrif_Root() ) THEN 
     185      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN 
    117186         iln    = INDEX(clname,'/')  
    118187         cltmpn = clname(1:iln) 
    … …  
    239308         i_s = 1 
    240309         i_e = jpmax_files 
     310#if defined key_iomput 
     311         CALL event__stop_ioserver 
     312#endif 
    241313      ENDIF 
    242314 
    … …  
    451523      ! do we read the overlap  
    452524      ! ugly patch SM+JMM+RB to overwrite global definition in some cases 
    453 #if ! defined key_agrif 
    454       llnoov = (jpni * jpnj ) == jpnij 
    455 #endif 
     525      llnoov = (jpni * jpnj ) == jpnij  
    456526      ! check kcount and kstart optionals parameters... 
    457527      IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 
    … …  
    819889      ENDIF 
    820890   END SUBROUTINE iom_rp3d 
     891 
     892 
    821893   !!---------------------------------------------------------------------- 
     894   !!                   INTERFACE iom_rstput 
     895   !!---------------------------------------------------------------------- 
     896   SUBROUTINE iom_p2d( cdname, pfield2d ) 
     897      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
     898      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pfield2d 
     899#if defined key_iomput 
     900      CALL event__write_field2D( cdname, pfield2d(nldi:nlei, nldj:nlej) ) 
     901#endif 
     902   END SUBROUTINE iom_p2d 
     903 
     904   SUBROUTINE iom_p3d( cdname, pfield3d ) 
     905      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
     906      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   pfield3d 
     907#if defined key_iomput 
     908      CALL event__write_field3D( cdname, pfield3d(nldi:nlei, nldj:nlej, :) ) 
     909#endif 
     910   END SUBROUTINE iom_p3d 
     911   !!---------------------------------------------------------------------- 
     912 
     913 
     914#if defined key_iomput 
     915 
     916   SUBROUTINE set_grid( cdname, plon, plat ) 
     917      !!---------------------------------------------------------------------- 
     918      !!                     ***  ROUTINE   *** 
     919      !! 
     920      !! ** Purpose :    
     921      !! 
     922      !!---------------------------------------------------------------------- 
     923      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
     924      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plon 
     925      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
     926 
     927      CALL event__set_grid_dimension( cdname, jpiglo, jpjglo) 
     928      CALL event__set_grid_domain( cdname, nlei-nldi+1, nlej-nldj+1, nimpp+nldi-1, njmpp+nldj-1, & 
     929         &                         plon(nldi:nlei, nldj:nlej), plat(nldi:nlei, nldj:nlej) ) 
     930      CALL event__set_grid_type_nemo( cdname ) 
     931 
     932   END SUBROUTINE set_grid 
     933 
     934 
     935   SUBROUTINE iom_init_chkcpp 
     936      !!--------------------------------------------------------------------- 
     937      !!                   ***  SUBROUTINE    *** 
     938      !! 
     939      !! ** Purpose :   
     940      !!--------------------------------------------------------------------- 
     941      USE zdfddm, ONLY :   lk_zdfddm      ! vertical  physics: double diffusion 
     942 
     943#if ! defined key_off_tra       
     944#if defined key_dynspg_rl 
     945      CALL event__disable_field( "sossheig" ) 
     946#else 
     947      CALL event__disable_field( "sobarstf" ) 
     948#endif 
     949 
     950      !!#if ! ( ! defined key_dynspg_rl && defined key_ice_lim) 
     951      !!        CALL disable_field( "iowaflup" ) 
     952      !!         CALL disable_field( "sowaflep" ) 
     953      !!#endif 
     954 
     955#if ! defined key_coupled 
     956      CALL event__enable_field( "sohefldp" ) 
     957      CALL event__enable_field( "sowafldp" ) 
     958      CALL event__enable_field( "sosafldp" ) 
     959#endif 
     960 
     961#if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )  
     962      CALL event__enable_field( "sohefldp" ) 
     963      CALL event__enable_field( "sowafldp" ) 
     964      CALL event__enable_field( "sosafldp" ) 
     965#endif 
     966 
     967#if ! defined key_diaspr 
     968      CALL event__disable_field( "sosurfps" ) 
     969#endif 
     970 
     971#if ! defined key_diahth 
     972      CALL event__disable_field( "sothedep" ) 
     973      CALL event__disable_field( "so20chgt" ) 
     974      CALL event__disable_field( "so28chgt" ) 
     975      CALL event__disable_field( "sohtc300" ) 
     976#endif 
     977 
     978#if defined key_coupled  
     979# if defined key_lim3 
     980      Must be adapted to LIM3 
     981# else 
     982      CALL event__enable_field( "soicetem" ) 
     983      CALL event__enable_field( "soicealb" ) 
     984# endif  
     985#endif  
     986 
     987#if ! defined key_diaeiv 
     988      CALL event__disable_field( "vozoeivu" ) 
     989      CALL event__disable_field( "vomeeivv" ) 
     990      CALL event__disable_field( "voveeivw" ) 
     991#endif 
     992 
     993#if ! defined key_dynspg_rl 
     994      CALL event__disable_field( "sozospgx" ) 
     995      CALL event__disable_field( "somespgy" ) 
     996#endif 
     997 
     998      IF( lk_zdfddm ) CALL event__enable_field( "voddmavs" ) 
     999 
     1000#if ! defined key_traldf_c2d 
     1001      CALL event__disable_field( "soleahtw" ) 
     1002#endif 
     1003 
     1004#if ! defined key_traldf_eiv  
     1005      CALL event__disable_field( "soleaeiw" ) 
     1006#endif 
     1007#endif 
     1008 
     1009   END SUBROUTINE iom_init_chkcpp 
     1010 
     1011#else 
     1012 
     1013   SUBROUTINE iom_setkt( kt ) 
     1014      INTEGER, INTENT(in   )::   kt  
     1015   END SUBROUTINE iom_setkt 
     1016 
     1017#endif 
    8221018 
    8231019 
Note: See TracChangeset for help on using the changeset viewer.