Changeset 4792 for branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

Timestamp:

2014-09-26T13:04:47+02:00 (10 years ago)

Author:

jamesharle

Message:

Updates to code after first successful test + merge with HEAD of trunk

File:

• branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90 (modified) (11 diffs)

branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

@@ -32 +32 @@
    USE trc_oce, ONLY :   nn_dttrc        !  !: frequency of step on passive tracers
    USE icb_oce, ONLY :   nclasses, class_num       !  !: iceberg classes
+#if defined key_lim3
+   USE par_ice
+#elif defined key_lim2
+   USE par_ice_2
+#endif
    USE domngb          ! ocean space and time domain
    USE phycst          ! physical constants
@@ -49 +54 @@
 #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, iom_context_finalize
+   PUBLIC iom_getatt, iom_use, iom_context_finalize
 
    PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
@@ -63 +68 @@
    END INTERFACE
    INTERFACE iom_getatt
-      MODULE PROCEDURE iom_g0d_intatt
+      MODULE PROCEDURE iom_g0d_intatt, iom_g0d_ratt
    END INTERFACE
    INTERFACE iom_rstput
@@ -143 +148 @@
       CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) )
 # endif
+#if defined key_lim3 || defined key_lim2
+      CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) )
+#endif
       CALL iom_set_axis_attr( "icbcla", class_num )
       
@@ -344 +352 @@
             CALL ctl_stop( TRIM(clinfo), 'We want to write in a new file but '//TRIM(clname)//' already exists...' )
             istop = nstop + 1                      ! make sure that istop /= nstop so we don't open the file
+         ELSEIF( llwrt ) THEN     ! the file exists and we are in write mode with permission to 
+            clname = cltmpn       ! overwrite so get back the file name without the cpu number
          ENDIF
       ENDIF
@@ -896 +906 @@
    !!                   INTERFACE iom_getatt
    !!----------------------------------------------------------------------
-   SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar )
+   SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar, cdvar )
       INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
       CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
-      INTEGER         , INTENT(  out)                 ::   pvar      ! read field
+      INTEGER         , INTENT(  out)                 ::   pvar      ! written field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable
       !
       IF( kiomid > 0 ) THEN
@@ -905 +916 @@
             SELECT CASE (iom_file(kiomid)%iolib)
             CASE (jpioipsl )   ;   CALL ctl_stop('iom_getatt: only nf90 available')
-            CASE (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pvar )
+            CASE (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pv_i0d=pvar )
             CASE (jprstdimg)   ;   CALL ctl_stop('iom_getatt: only nf90 available')
             CASE DEFAULT    
@@ -914 +925 @@
    END SUBROUTINE iom_g0d_intatt
 
+   SUBROUTINE iom_g0d_ratt( kiomid, cdatt, pvar, cdvar )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
+      REAL(wp)        , INTENT(  out)                 ::   pvar      ! written field
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpioipsl )   ;   CALL ctl_stop('iom_getatt: only nf90 available')
+            CASE (jpnf90   )   ;   IF( PRESENT(cdvar) ) THEN
+                                      CALL iom_nf90_getatt( kiomid, cdatt, pv_r0d=pvar, cdvar=cdvar )
+                                   ELSE
+                                      CALL iom_nf90_getatt( kiomid, cdatt, pv_r0d=pvar )
+                                   ENDIF
+            CASE (jprstdimg)   ;   CALL ctl_stop('iom_getatt: only nf90 available')
+            CASE DEFAULT    
+               CALL ctl_stop( 'iom_g0d_att: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_g0d_ratt
 
    !!----------------------------------------------------------------------
@@ -1013 +1046 @@
       CHARACTER(LEN=*), INTENT(in) ::   cdname
       REAL(wp)        , INTENT(in) ::   pfield0d
+      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson
 #if defined key_iomput
-      CALL xios_send_field(cdname, (/pfield0d/))
+      zz(:,:)=pfield0d
+      CALL xios_send_field(cdname, zz)
+      !CALL xios_send_field(cdname, (/pfield0d/)) 
 #else
       IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings
@@ -1205 +1241 @@
       !!
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(1,1) ::   zz = 1.
+      REAL(wp), DIMENSION(1) ::   zz = 1.
       !!----------------------------------------------------------------------
       CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1)
-      CALL iom_set_domain_attr('scalarpoint', data_dim=1)
-      CALL iom_set_domain_attr('scalarpoint', lonvalue=(/ zz /), latvalue=(/ zz /))
+      CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1)
+      zz=REAL(narea,wp)
+      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz)
 
    END SUBROUTINE set_scalar
@@ -1497 +1534 @@
 
 #endif
+
+   LOGICAL FUNCTION iom_use( cdname )
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+#if defined key_iomput
+      iom_use = xios_field_is_active( cdname )
+#else
+      iom_use = .FALSE.
+#endif
+   END FUNCTION iom_use
    
    !!======================================================================