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

Timestamp:

2008-09-24T15:05:20+02:00 (16 years ago)

Author:

rblod

Message:

Adapt Agrif to the new SBC and correct several bugs for agrif (restart writing and reading), see ticket #133
Note : this fix does not work yet on NEC computerq (sxf90/360)

File:

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

trunk/NEMO/OPA_SRC/IOM/iom.F90

@@ -69 +69 @@
       LOGICAL               ::   llok      ! check the existence 
       LOGICAL               ::   llwrt     ! local definition of ldwrt
+      LOGICAL               ::   llnoov    ! local definition to read overlap
       LOGICAL               ::   llstop    ! local definition of ldstop
       INTEGER               ::   iolib     ! library do we use to open the file
@@ -104 +105 @@
       ELSE                         ;   iolib = jpnf90
       ENDIF
+      ! do we read the overlap 
+      ! ugly patch SM+JMM+RB to overwrite global definition in some cases
+      llnoov = (jpni * jpnj ) == jpni .AND. .NOT. lk_agrif 
       ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
       ! =============
       clname   = trim(cdname)
 #if defined key_agrif
-      if ( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
+      IF ( .NOT. Agrif_Root() ) THEN
+         iln    = INDEX(clname,'/') 
+         cltmpn = clname(1:iln)
+         clname = clname(iln+1:LEN_TRIM(clname))
+         clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
+      ENDIF
 #endif    
       ! which suffix should we use?
@@ -149 +158 @@
 ! JMM + SM: ugly patch before getting the new version of lib_mpp)
 !         idom = jpdom_local_noovlap   ! default definition
-         IF( jpni*jpnj == jpnij ) THEN   ;   idom = jpdom_local_noovlap   ! default definition
-         ELSE                            ;   idom = jpdom_local_full      ! default definition
+         IF( llnoov ) THEN   ;   idom = jpdom_local_noovlap   ! default definition
+         ELSE                ;   idom = jpdom_local_full      ! default definition
          ENDIF
          IF( PRESENT(kdom) )   idom = kdom
@@ -411 +420 @@
       INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis
       !
+      LOGICAL                        ::   llnoov      ! local definition to read overlap
       INTEGER                        ::   jl          ! loop on number of dimension 
       INTEGER                        ::   idom        ! type of domain
@@ -437 +447 @@
       ! local definition of the domain ?
       idom = kdom
+      ! do we read the overlap 
+      ! ugly patch SM+JMM+RB to overwrite global definition in some cases
+      llnoov = (jpni * jpnj ) == jpni .AND. .NOT. lk_agrif 
       ! check kcount and kstart optionals parameters...
       IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present')
@@ -520 +533 @@
 ! JMM + SM: ugly patch before getting the new version of lib_mpp)
 !                  IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
-                  IF( jpni*jpnj == jpnij .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
+                  IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
                   ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 
 ! JMM + SM: ugly patch before getting the new version of lib_mpp)
 !                  icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
-                  IF( jpni*jpnj == jpnij ) THEN   ;   icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
-                  ELSE                            ;   icnt(1:2) = (/ nlci           , nlcj            /)
+                  IF( llnoov ) THEN   ;   icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
+                  ELSE                ;   icnt(1:2) = (/ nlci           , nlcj            /)
                   ENDIF
                   IF( PRESENT(pv_r3d) ) THEN
@@ -558 +571 @@
 ! JMM + SM: ugly patch before getting the new version of lib_mpp)
 !               ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)'
-               IF( jpni*jpnj == jpnij ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)'
-               ELSE                          ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)'
+               IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)'
+               ELSE              ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)'
                ENDIF
             ENDIF
@@ -565 +578 @@
 ! JMM + SM: ugly patch before getting the new version of lib_mpp)
 !               ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'
-               IF( jpni*jpnj == jpnij ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'
-               ELSE                          ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'
+               IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'
+               ELSE              ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'
                ENDIF
             ENDIF
@@ -587 +600 @@
 !         ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
 !         ENDIF
-         IF( jpni*jpnj == jpnij ) THEN
+         IF( llnoov ) THEN
             IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
             ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)