Ignore:
Timestamp:
2020-06-19T08:18:11+02:00 (3 months ago)
Author:
smasson
Message:

Extra_Halo: supress halos from outputs and coupling, see #2366

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom.F90

    r12960 r13130  
    9494CONTAINS 
    9595 
    96    SUBROUTINE iom_init( cdname, fname, ld_tmppatch, ld_closedef )  
     96   SUBROUTINE iom_init( cdname, fname, ld_closedef )  
    9797      !!---------------------------------------------------------------------- 
    9898      !!                     ***  ROUTINE   *** 
     
    103103      CHARACTER(len=*),           INTENT(in)  :: cdname 
    104104      CHARACTER(len=*), OPTIONAL, INTENT(in)  :: fname 
    105       LOGICAL         , OPTIONAL, INTENT(in)  :: ld_tmppatch 
    106105      LOGICAL         , OPTIONAL, INTENT(in)  :: ld_closedef 
    107106#if defined key_iomput 
     
    116115      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 
    117116      REAL(wp), DIMENSION(2,jpkam1)         :: za_bnds   ! ABL vertical boundaries 
    118       LOGICAL ::   ll_tmppatch = .TRUE.    !: seb: patch before we remove periodicity 
    119       INTEGER ::   Nis0_save, Nie0_save    !:      and close boundaries in output files 
    120       INTEGER ::   Njs0_save, Nje0_save    !: 
    121       INTEGER ::   Ni_0_save, Nj_0_save    !: 
    122117      LOGICAL ::   ll_closedef = .TRUE. 
    123118      !!---------------------------------------------------------------------- 
    124119      ! 
    125       ! seb: patch before we remove periodicity and close boundaries in output files 
    126       IF( PRESENT(ld_tmppatch) ) THEN   ;   ll_tmppatch = ld_tmppatch 
    127       ELSE                              ;   ll_tmppatch = .TRUE. 
    128       ENDIF 
    129       IF ( ll_tmppatch ) THEN 
    130          Nis0_save = Nis0   ;   Nie0_save = Nie0 
    131          Njs0_save = Njs0   ;   Nje0_save = Nje0 
    132          Ni_0_save = Ni_0   ;   Nj_0_save = Nj_0 
    133          IF( mig( 1 ) ==      1 ) Nis0 = 1 
    134          IF( mig(jpi) == jpiglo ) Nie0 = jpi 
    135          IF( mjg( 1 ) ==      1 ) Njs0 = 1 
    136          IF( mjg(jpj) == jpjglo ) Nje0 = jpj 
    137          Ni_0 = Nie0 - Nis0 + 1 
    138          Nj_0 = Nje0 - Njs0 + 1 
    139       ENDIF 
    140120      IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef 
    141121      ! 
     
    285265      DEALLOCATE( zt_bnds, zw_bnds ) 
    286266      ! 
    287       IF ( ll_tmppatch ) THEN 
    288          Nis0 = Nis0_save   ;   Nie0 = Nie0_save 
    289          Njs0 = Njs0_save   ;   Nje0 = Nje0_save 
    290          Ni_0 = Ni_0_save   ;   Nj_0 = Nj_0_save 
    291       ENDIF 
    292267#endif 
    293268      ! 
     
    695670      INTEGER               ::   iln, ils  ! lengths of character 
    696671      INTEGER               ::   istop     !  
    697       INTEGER, DIMENSION(2,5) ::   idompar ! domain parameters:  
    698672      ! local number of points for x,y dimensions 
    699673      ! position of first local point for x,y dimensions 
     
    765739      ELSE 
    766740         lxios_sini = .TRUE. 
    767       ENDIF 
    768       IF( llwrt ) THEN 
    769          idompar(:,1) = (/ Ni_0     , Nj_0      /) 
    770          idompar(:,2) = (/ mig(Nis0), mjg(Njs0) /) 
    771          idompar(:,3) = (/ mig(Nie0), mjg(Nje0) /) 
    772          idompar(:,4) = (/ 0        , 0         /) 
    773          idompar(:,5) = (/ 0        , 0         /) 
    774741      ENDIF 
    775742      ! Open the NetCDF file 
     
    796763      ENDIF 
    797764      IF( istop == nstop ) THEN   ! no error within this routine 
    798          CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev, cdcomp = cdcomp ) 
     765         CALL iom_nf90_open( clname, kiomid, llwrt, llok, kdlev = kdlev, cdcomp = cdcomp ) 
    799766      ENDIF 
    800767      ! 
     
    16541621      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
    16551622      REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
     1623      IF( iom_use(cdname) ) THEN 
    16561624#if defined key_iomput 
    1657       CALL xios_send_field(cdname, pfield2d) 
     1625         IF( SIZE(pfield2d, dim=1) == jpi .AND. SIZE(pfield2d, dim=2) == jpj ) THEN 
     1626            CALL xios_send_field( cdname, pfield2d(Nis0:Nie0, Njs0:Nje0) )       ! this extraction will create a copy of pfield2d 
     1627         ELSE 
     1628            CALL xios_send_field( cdname, pfield2d ) 
     1629         ENDIF 
    16581630#else 
    1659       IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings 
    1660 #endif 
     1631         WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1632#endif 
     1633      ENDIF 
    16611634   END SUBROUTINE iom_p2d 
    16621635 
     
    16641637      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    16651638      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
     1639      IF( iom_use(cdname) ) THEN 
    16661640#if defined key_iomput 
    1667       CALL xios_send_field( cdname, pfield3d ) 
     1641         IF( SIZE(pfield3d, dim=1) == jpi .AND. SIZE(pfield3d, dim=2) == jpj ) THEN 
     1642            CALL xios_send_field( cdname, pfield3d(Nis0:Nie0, Njs0:Nje0,:) )     ! this extraction will create a copy of pfield3d 
     1643         ELSE 
     1644            CALL xios_send_field( cdname, pfield3d ) 
     1645         ENDIF 
    16681646#else 
    1669       IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings 
    1670 #endif 
     1647         WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1648#endif 
     1649      ENDIF 
    16711650   END SUBROUTINE iom_p3d 
    16721651 
     
    16741653      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    16751654      REAL(wp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d 
     1655      IF( iom_use(cdname) ) THEN 
    16761656#if defined key_iomput 
    1677       CALL xios_send_field(cdname, pfield4d) 
     1657         IF( SIZE(pfield4d, dim=1) == jpi .AND. SIZE(pfield4d, dim=2) == jpj ) THEN 
     1658            CALL xios_send_field( cdname, pfield4d(Nis0:Nie0, Njs0:Nje0,:,:) )   ! this extraction will create a copy of pfield4d 
     1659         ELSE 
     1660            CALL xios_send_field (cdname, pfield4d ) 
     1661         ENDIF 
    16781662#else 
    1679       IF( .FALSE. )   WRITE(numout,*) cdname, pfield4d   ! useless test to avoid compilation warnings 
    1680 #endif 
     1663         WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1664#endif 
     1665      ENDIF 
    16811666   END SUBROUTINE iom_p4d 
    16821667 
     
    18751860      !!---------------------------------------------------------------------- 
    18761861      ! 
    1877       CALL iom_set_domain_attr("grid_"//cdgrd,ni_glo=jpiglo,nj_glo=jpjglo,ibegin=nimpp+Nis0-2,jbegin=njmpp+Njs0-2,ni=Ni_0,nj=Nj_0) 
    1878       CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-Nis0, data_ni = jpi, data_jbegin = 1-Njs0, data_nj = jpj) 
     1862      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig0(Nis0)-1,jbegin=mjg0(Njs0)-1,ni=Ni_0,nj=Nj_0) 
     1863      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 0, data_ni = Ni_0, data_jbegin = 0, data_nj = Nj_0) 
    18791864!don't define lon and lat for restart reading context.  
    18801865      IF ( .NOT.ldrxios ) & 
     
    18861871         SELECT CASE ( cdgrd ) 
    18871872         CASE('T')   ;   zmask(:,:,:)       = tmask(:,:,:) 
    1888          CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( 'iom', zmask, 'U', 1. ) 
    1889          CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( 'iom', zmask, 'V', 1. ) 
     1873         CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) 
     1874         CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) 
    18901875         CASE('W')   ;   zmask(:,:,2:jpk  ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk)   ;   zmask(:,:,1) = tmask(:,:,1) 
    18911876         END SELECT 
     
    19301915      ! 
    19311916      ! Cell vertices that can be defined 
    1932       DO jj = 2, jpjm1 
    1933          DO ji = 2, jpim1 
    1934             z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
    1935             z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
    1936             z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
    1937             z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
    1938             z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
    1939             z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
    1940             z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
    1941             z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
    1942          END DO 
    1943       END DO 
    1944       ! 
    1945       ! Cell vertices on boundries 
    1946       DO jn = 1, 4 
    1947          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., pfillval=999._wp ) 
    1948          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., pfillval=999._wp ) 
    1949       END DO 
    1950       ! 
    1951       ! Zero-size cells at closed boundaries if cell points provided, 
    1952       ! otherwise they are closed cells with unrealistic bounds 
    1953       IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN 
    1954          IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
    1955             DO jn = 1, 4        ! (West or jpni = 1), closed E-W 
    1956                z_bnds(jn,1,:,1) = plat_pnt(1,:)  ;  z_bnds(jn,1,:,2) = plon_pnt(1,:) 
    1957             END DO 
     1917      DO_2D_00_00 
     1918         z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
     1919         z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
     1920         z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
     1921         z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
     1922         z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
     1923         z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
     1924         z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
     1925         z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
     1926      END_2D 
     1927      ! 
     1928      DO_2D_00_00 
     1929         IF( z_fld(ji,jj) == -1. ) THEN 
     1930            z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 
     1931            z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 
     1932            z_bnds(:,ji,jj,:) = z_rot(:,:) 
    19581933         ENDIF 
    1959          IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
    1960             DO jn = 1, 4        ! (East or jpni = 1), closed E-W 
    1961                z_bnds(jn,jpi,:,1) = plat_pnt(jpi,:)  ;  z_bnds(jn,jpi,:,2) = plon_pnt(jpi,:) 
    1962             END DO 
    1963          ENDIF 
    1964          IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN 
    1965             DO jn = 1, 4        ! South or (jpnj = 1, not symmetric) 
    1966                z_bnds(jn,:,1,1) = plat_pnt(:,1)  ;  z_bnds(jn,:,1,2) = plon_pnt(:,1) 
    1967             END DO 
    1968          ENDIF 
    1969          IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio  < 3 ) THEN 
    1970             DO jn = 1, 4        ! (North or jpnj = 1), no north fold 
    1971                z_bnds(jn,:,jpj,1) = plat_pnt(:,jpj)  ;  z_bnds(jn,:,jpj,2) = plon_pnt(:,jpj) 
    1972             END DO 
    1973          ENDIF 
    1974       ENDIF 
    1975       ! 
    1976       IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN    ! Rotate cells at the north fold 
    1977          DO jj = 1, jpj 
    1978             DO ji = 1, jpi 
    1979                IF( z_fld(ji,jj) == -1. ) THEN 
    1980                   z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 
    1981                   z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 
    1982                   z_bnds(:,ji,jj,:) = z_rot(:,:) 
    1983                ENDIF 
    1984             END DO 
    1985          END DO 
    1986       ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN                  ! Invert cells at the symmetric equator 
    1987          DO ji = 1, jpi 
    1988             z_rot(1:2,:) = z_bnds(3:4,ji,1,:) 
    1989             z_rot(3:4,:) = z_bnds(1:2,ji,1,:) 
    1990             z_bnds(:,ji,1,:) = z_rot(:,:) 
    1991          END DO 
    1992       ENDIF 
     1934      END_2D 
    19931935      ! 
    19941936      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)),           & 
     
    20171959!      CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
    20181960      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
    2019       CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+Nis0-2, jbegin=njmpp+Njs0-2, ni=Ni_0, nj=Nj_0) 
    2020       CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-Nis0, data_ni = jpi, data_jbegin = 1-Njs0, data_nj = jpj) 
     1961      CALL iom_set_domain_attr("gznl", ni_glo=Ni0glo, nj_glo=Nj0glo, ibegin=mig0(Nis0)-1, jbegin=mjg0(Njs0)-1, ni=Ni_0, nj=Nj_0) 
     1962      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 0, data_ni = Ni_0, data_jbegin = 0, data_nj = Nj_0) 
    20211963      CALL iom_set_domain_attr("gznl", lonvalue = zlon,   & 
    20221964         &                             latvalue = RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)))   
    2023       CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 
     1965      CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=Nj_0) 
    20241966      ! 
    20251967      CALL iom_update_file_name('ptr') 
     
    20982040         ! Equatorial section (attributs: jbegin, ni, name_suffix) 
    20992041         CALL dom_ngb( 0., 0., ix, iy, cl1 ) 
    2100          CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=jpiglo, nj=1 ) 
     2042         CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=Ni0glo, nj=1 ) 
    21012043         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             ) 
    21022044         CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') 
Note: See TracChangeset for help on using the changeset viewer.