- Timestamp:
- 2020-04-23T15:14:45+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM
- Files:
-
- 4 edited
-
iom.F90 (modified) (26 diffs)
-
iom_def.F90 (modified) (1 diff)
-
iom_nf90.F90 (modified) (2 diffs)
-
prtctl.F90 (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom.F90
r12745 r12807 21 21 !!---------------------------------------------------------------------- 22 22 USE dom_oce ! ocean space and time domain 23 USE domutl ! 23 24 USE c1d ! 1D vertical configuration 24 25 USE flo_oce ! floats module declarations … … 34 35 USE ice , ONLY : jpl 35 36 #endif 36 USE domngb ! ocean space and time domain37 37 USE phycst ! physical constants 38 38 USE dianam ! build name of file … … 117 117 REAL(wp), DIMENSION(2,jpkam1) :: za_bnds ! ABL vertical boundaries 118 118 LOGICAL :: ll_tmppatch = .TRUE. !: seb: patch before we remove periodicity 119 INTEGER :: nldi_save, nlei_save !: and close boundaries in output files120 INTEGER :: nldj_save, nlej_save !:119 INTEGER :: Nis0_save, Nie0_save !: and close boundaries in output files 120 INTEGER :: Njs0_save, Nje0_save !: 121 121 LOGICAL :: ll_closedef = .TRUE. 122 122 !!---------------------------------------------------------------------- … … 127 127 ENDIF 128 128 IF ( ll_tmppatch ) THEN 129 nldi_save = nldi ; nlei_save = nlei130 nldj_save = nldj ; nlej_save = nlej131 IF( nimpp == 1 ) nldi= 1132 IF( nimpp + jpi - 1 == jpiglo ) nlei= jpi133 IF( njmpp == 1 ) nldj= 1134 IF( njmpp + jpj - 1 == jpjglo ) nlej= jpj129 Nis0_save = Nis0 ; Nie0_save = Nie0 130 Njs0_save = Njs0 ; Nje0_save = Nje0 131 IF( nimpp == 1 ) Nis0 = 1 132 IF( nimpp + jpi - 1 == jpiglo ) Nie0 = jpi 133 IF( njmpp == 1 ) Njs0 = 1 134 IF( njmpp + jpj - 1 == jpjglo ) Nje0 = jpj 135 135 ENDIF 136 136 IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef … … 169 169 ! 170 170 IF( ln_cfmeta ) THEN ! Add additional grid metadata 171 CALL iom_set_domain_attr("grid_T", area = e1e2t( nldi:nlei, nldj:nlej))172 CALL iom_set_domain_attr("grid_U", area = e1e2u( nldi:nlei, nldj:nlej))173 CALL iom_set_domain_attr("grid_V", area = e1e2v( nldi:nlei, nldj:nlej))174 CALL iom_set_domain_attr("grid_W", area = e1e2t( nldi:nlei, nldj:nlej))171 CALL iom_set_domain_attr("grid_T", area = e1e2t(Nis0:Nie0, Njs0:Nje0)) 172 CALL iom_set_domain_attr("grid_U", area = e1e2u(Nis0:Nie0, Njs0:Nje0)) 173 CALL iom_set_domain_attr("grid_V", area = e1e2v(Nis0:Nie0, Njs0:Nje0)) 174 CALL iom_set_domain_attr("grid_W", area = e1e2t(Nis0:Nie0, Njs0:Nje0)) 175 175 CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 176 176 CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) … … 192 192 ! 193 193 IF( ln_cfmeta .AND. .NOT. llrst_context) THEN ! Add additional grid metadata 194 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs( nldi:nlei, nldj:nlej))195 CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej))196 CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej))197 CALL iom_set_domain_attr("grid_W", area = e1e2t_crs( nldi:nlei, nldj:nlej))194 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(Nis0:Nie0, Njs0:Nje0)) 195 CALL iom_set_domain_attr("grid_U", area = e1u_crs(Nis0:Nie0, Njs0:Nje0) * e2u_crs(Nis0:Nie0, Njs0:Nje0)) 196 CALL iom_set_domain_attr("grid_V", area = e1v_crs(Nis0:Nie0, Njs0:Nje0) * e2v_crs(Nis0:Nie0, Njs0:Nje0)) 197 CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(Nis0:Nie0, Njs0:Nje0)) 198 198 CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 199 199 CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) … … 283 283 ! 284 284 IF ( ll_tmppatch ) THEN 285 nldi = nldi_save ; nlei = nlei_save286 nldj = nldj_save ; nlej = nlej_save285 Nis0 = Nis0_save ; Nie0 = Nie0_save 286 Njs0 = Njs0_save ; Nje0 = Nje0_save 287 287 ENDIF 288 288 #endif … … 762 762 ENDIF 763 763 IF( llwrt ) THEN 764 idompar(:,1) = (/ nlei - nldi + 1, nlej - nldj + 1/)765 idompar(:,2) = (/ mig( nldi) , mjg(nldj)/)766 idompar(:,3) = (/ mig( nlei) , mjg(nlej)/)767 idompar(:,4) = (/ 0 , 0/)768 idompar(:,5) = (/ 0 , 0/)764 idompar(:,1) = (/ Ni_0 , Nj_0 /) 765 idompar(:,2) = (/ mig(Nis0), mjg(Njs0) /) 766 idompar(:,3) = (/ mig(Nie0), mjg(Nje0) /) 767 idompar(:,4) = (/ 0 , 0 /) 768 idompar(:,5) = (/ 0 , 0 /) 769 769 ENDIF 770 770 ! Open the NetCDF file … … 976 976 END SUBROUTINE iom_g1d 977 977 978 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, k start, kcount, ldxios)978 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 979 979 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 980 980 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 984 984 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 985 985 REAL(wp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold 986 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 986 987 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 987 988 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis … … 989 990 ! 990 991 IF( kiomid > 0 ) THEN 991 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, &992 & ktime=ktime , cd_type = cd_type, psgn = psgn, &993 & kstart =kstart, kcount=kcount, ldxios=ldxios )992 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = pvar , ktime = ktime, & 993 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 994 & kstart = kstart , kcount = kcount, ldxios=ldxios ) 994 995 ENDIF 995 996 END SUBROUTINE iom_g2d 996 997 997 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, k start, kcount, ldxios )998 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios ) 998 999 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 999 1000 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1003 1004 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1004 1005 REAL(wp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1006 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1005 1007 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1006 1008 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis … … 1008 1010 ! 1009 1011 IF( kiomid > 0 ) THEN 1010 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, &1011 & ktime=ktime , cd_type = cd_type, psgn = psgn, &1012 & kstart =kstart, kcount=kcount, ldxios=ldxios )1012 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = pvar , ktime = ktime, & 1013 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1014 & kstart = kstart , kcount = kcount, ldxios=ldxios ) 1013 1015 ENDIF 1014 1016 END SUBROUTINE iom_g3d 1015 1017 !!---------------------------------------------------------------------- 1016 1018 1017 SUBROUTINE iom_get_123d( kiomid , kdom , cdvar , pv_r1d, pv_r2d, pv_r3d, &1018 & ktime , cd_type, psgn, kstart, kcount, ldxios )1019 SUBROUTINE iom_get_123d( kiomid , kdom, cdvar, pv_r1d, pv_r2d, pv_r3d, ktime , & 1020 & cd_type, psgn, kfill, kstart, kcount, ldxios ) 1019 1021 !!----------------------------------------------------------------------- 1020 1022 !! *** ROUTINE iom_get_123d *** … … 1033 1035 CHARACTER(len=1) , INTENT(in ), OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1034 1036 REAL(wp) , INTENT(in ), OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1037 INTEGER , INTENT(in ), OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1035 1038 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 1036 1039 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis … … 1158 1161 ENDIF 1159 1162 ELSE ! not a 1D array as pv_r1d requires jpdom_unknown 1160 ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej1161 IF( idom == jpdom_global ) istart(1:2) = (/ mig( nldi), mjg(nldj)/)1162 icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1/)1163 ! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0 1164 IF( idom == jpdom_global ) istart(1:2) = (/ mig(Nis0)-nn_hls, mjg(Njs0)-nn_hls /) 1165 icnt(1:2) = (/ Ni_0, Nj_0 /) 1163 1166 IF( PRESENT(pv_r3d) ) THEN 1164 1167 IF( idom == jpdom_auto_xy ) THEN … … 1191 1194 ELSE 1192 1195 IF( irankpv == 2 ) THEN 1193 ishape(1:2) = SHAPE(pv_r2d( nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)'1196 ishape(1:2) = SHAPE(pv_r2d(Nis0:Nie0,Njs0:Nje0 )) ; ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0)' 1194 1197 ENDIF 1195 1198 IF( irankpv == 3 ) THEN 1196 ishape(1:3) = SHAPE(pv_r3d( nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'1199 ishape(1:3) = SHAPE(pv_r3d(Nis0:Nie0,Njs0:Nje0,:)) ; ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0,:)' 1197 1200 ENDIF 1198 1201 ENDIF … … 1209 1212 ! 1210 1213 ! find the right index of the array to be read 1211 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej1214 IF( idom /= jpdom_unknown ) THEN ; ix1 = Nis0 ; ix2 = Nie0 ; iy1 = Njs0 ; iy2 = Nje0 1212 1215 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1213 1216 ENDIF … … 1224 1227 !--- overlap areas and extra hallows (mpp) 1225 1228 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1226 CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = jpfillnothing)1229 CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = kfill ) 1227 1230 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1228 CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = jpfillnothing)1231 CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill ) 1229 1232 ENDIF 1230 1233 ! … … 1863 1866 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 1864 1867 ! 1865 INTEGER :: ni, nj1866 1868 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask 1867 1869 LOGICAL, INTENT(IN) :: ldxios, ldrxios 1868 1870 !!---------------------------------------------------------------------- 1869 1871 ! 1870 ni = nlei-nldi+1 1871 nj = nlej-nldj+1 1872 ! 1873 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1874 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1872 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) 1873 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-Nis0, data_ni = jpi, data_jbegin = 1-Njs0, data_nj = jpj) 1875 1874 !don't define lon and lat for restart reading context. 1876 1875 IF ( .NOT.ldrxios ) & 1877 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon( nldi:nlei, nldj:nlej),(/ ni*nj/)), &1878 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj/)))1876 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)), & 1877 & latvalue = RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /))) 1879 1878 ! 1880 1879 IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN … … 1887 1886 END SELECT 1888 1887 ! 1889 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask( nldi:nlei,nldj:nlej,1),(/ni*nj/)) /= 0. )1890 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask( nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. )1888 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,1),(/Ni_0*Nj_0 /)) /= 0. ) 1889 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,:),(/Ni_0*Nj_0,jpk/)) /= 0. ) 1891 1890 ENDIF 1892 1891 ! … … 1905 1904 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coord. of the point of cell (i,j) 1906 1905 ! 1907 INTEGER :: ji, jj, jn , ni, nj1906 INTEGER :: ji, jj, jn 1908 1907 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 1909 1908 ! ! represents the bottom-left corner of cell (i,j) … … 1921 1920 CASE ('V') ; icnr = -1 ; jcnr = 0 1922 1921 END SELECT 1923 !1924 ni = nlei-nldi+1 ! Dimensions of subdomain interior1925 nj = nlej-nldj+11926 1922 ! 1927 1923 z_fld(:,:) = 1._wp … … 1958 1954 IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 1959 1955 DO jn = 1, 4 ! (East or jpni = 1), closed E-W 1960 z_bnds(jn, nlci,:,1) = plat_pnt(nlci,:) ; z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:)1956 z_bnds(jn,jpi,:,1) = plat_pnt(jpi,:) ; z_bnds(jn,jpi,:,2) = plon_pnt(jpi,:) 1961 1957 END DO 1962 1958 ENDIF … … 1968 1964 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio < 3 ) THEN 1969 1965 DO jn = 1, 4 ! (North or jpnj = 1), no north fold 1970 z_bnds(jn,:, nlcj,1) = plat_pnt(:,nlcj) ; z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj)1966 z_bnds(jn,:,jpj,1) = plat_pnt(:,jpj) ; z_bnds(jn,:,jpj,2) = plon_pnt(:,jpj) 1971 1967 END DO 1972 1968 ENDIF … … 1991 1987 ENDIF 1992 1988 ! 1993 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:, nldi:nlei,nldj:nlej,1),(/ 4,ni*nj/)), &1994 & bounds_lon = RESHAPE(z_bnds(:, nldi:nlei,nldj:nlej,2),(/ 4,ni*nj/)), nvertex=4 )1989 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)), & 1990 & bounds_lon = RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,2),(/ 4,Ni_0*Nj_0 /)), nvertex=4 ) 1995 1991 ! 1996 1992 DEALLOCATE( z_bnds, z_fld, z_rot ) … … 2008 2004 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 2009 2005 ! 2010 INTEGER :: ni, nj,ix, iy2006 INTEGER :: ix, iy 2011 2007 REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon 2012 2008 !!---------------------------------------------------------------------- 2013 2009 ! 2014 ni=nlei-nldi+1 ! define zonal mean domain (jpj*jpk)2015 nj=nlej-nldj+12016 2010 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0._wp 2017 2011 ! 2018 2012 ! CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots) 2019 2013 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 2020 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+ nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)2021 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1- nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)2014 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) 2015 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-Nis0, data_ni = jpi, data_jbegin = 1-Njs0, data_nj = jpj) 2022 2016 CALL iom_set_domain_attr("gznl", lonvalue = zlon, & 2023 & latvalue = RESHAPE(plat( nldi:nlei, nldj:nlej),(/ ni*nj/)))2017 & latvalue = RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /))) 2024 2018 CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 2025 2019 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom_def.F90
r12738 r12807 14 14 15 15 INTEGER, PARAMETER, PUBLIC :: jpdom_global = 1 !: ( 1 :jpiglo, 1 :jpjglo) 16 INTEGER, PARAMETER, PUBLIC :: jpdom_local = 2 !: ( nldi:nlei ,nldj:nlej)16 INTEGER, PARAMETER, PUBLIC :: jpdom_local = 2 !: (Nis0: Nie0 ,Njs0: Nje0 ) 17 17 INTEGER, PARAMETER, PUBLIC :: jpdom_unknown = 3 !: No dimension checking 18 18 INTEGER, PARAMETER, PUBLIC :: jpdom_auto = 4 !: -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom_nf90.F90
r12377 r12807 134 134 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', jpk, idmy ), clinfo) 135 135 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 136 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numcat', kdlev, idmy ), clinfo)136 IF( kdlev > 0 ) CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numcat', kdlev, idmy ), clinfo) 137 137 ENDIF 138 138 ELSE … … 665 665 IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN 666 666 idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar) 667 IF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1)) THEN668 ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej669 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj) THEN670 ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj671 ELSEIF( idimsz(1) == jpi .AND. idimsz(2) == jpj) THEN667 IF( idimsz(1) == Ni_0 .AND. idimsz(2) == Nj_0 ) THEN 668 ix1 = Nis0 ; ix2 = Nie0 ; iy1 = Njs0 ; iy2 = Nje0 669 ELSEIF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN 670 ix1 = 1 ; ix2 = jpi ; iy1 = 1 ; iy2 = jpj 671 ELSEIF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN 672 672 ix1 = 1 ; ix2 = jpi ; iy1 = 1 ; iy2 = jpj 673 673 ELSE -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/prtctl.F90
r12377 r12807 18 18 19 19 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: numid 20 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: n lditl , nldjtl! first, last indoor index for each i-domain21 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: n leitl , nlejtl! first, last indoor index for each j-domain22 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: nimpptl,njmpptl ! i-, j-indexes for each processor23 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: nlcitl , nlcjtl! dimensions of every subdomain24 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: ibonitl,ibonjtl !20 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: nis0allp, njs0allp ! first, last indoor index for each i-domain 21 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: nie0allp, nje0allp ! first, last indoor index for each j-domain 22 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: nimpptl, njmpptl ! i-, j-indexes for each processor 23 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: jpiallp, jpjallp ! dimensions of every subdomain 24 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: ibonitl, ibonjtl ! 25 25 26 26 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: t_ctll , s_ctll ! previous tracer trend values … … 134 134 IF( .NOT. lsp_area ) THEN 135 135 IF (lk_mpp .AND. jpnij > 1) THEN 136 nictls = MAX( 1, n lditl(jn) )137 nictle = MIN(jpi, n leitl(jn) )138 njctls = MAX( 1, n ldjtl(jn) )139 njctle = MIN(jpj, n lejtl(jn) )136 nictls = MAX( 1, nis0allp(jn) ) 137 nictle = MIN(jpi, nie0allp(jn) ) 138 njctls = MAX( 1, njs0allp(jn) ) 139 njctle = MIN(jpj, nje0allp(jn) ) 140 140 ! Do not take into account the bound of the domain 141 141 IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls) 142 142 IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls) 143 IF( ibonitl(jn) == 1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, n leitl(jn) - 1)144 IF( ibonjtl(jn) == 1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, n lejtl(jn) - 1)143 IF( ibonitl(jn) == 1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nie0allp(jn) - 1) 144 IF( ibonjtl(jn) == 1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, nje0allp(jn) - 1) 145 145 ELSE 146 nictls = MAX( 1, nimpptl(jn) - 1 + n lditl(jn) )147 nictle = MIN(jpi, nimpptl(jn) - 1 + n leitl(jn) )148 njctls = MAX( 1, njmpptl(jn) - 1 + n ldjtl(jn) )149 njctle = MIN(jpj, njmpptl(jn) - 1 + n lejtl(jn) )146 nictls = MAX( 1, nimpptl(jn) - 1 + nis0allp(jn) ) 147 nictle = MIN(jpi, nimpptl(jn) - 1 + nie0allp(jn) ) 148 njctls = MAX( 1, njmpptl(jn) - 1 + njs0allp(jn) ) 149 njctle = MIN(jpj, njmpptl(jn) - 1 + nje0allp(jn) ) 150 150 ! Do not take into account the bound of the domain 151 151 IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls) 152 152 IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls) 153 IF( ibonitl(jn) == 1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nimpptl(jn) + n leitl(jn) - 2)154 IF( ibonjtl(jn) == 1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, njmpptl(jn) + n lejtl(jn) - 2)153 IF( ibonitl(jn) == 1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nimpptl(jn) + nie0allp(jn) - 2) 154 IF( ibonjtl(jn) == 1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, njmpptl(jn) + nje0allp(jn) - 2) 155 155 ENDIF 156 156 ENDIF … … 277 277 278 278 ! Allocate arrays 279 ALLOCATE( n lditl(ijsplt) , nleitl(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) , &280 & n ldjtl(ijsplt) , nlejtl(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) , &281 & nlcitl(ijsplt) , t_ctll(ijsplt) , u_ctll(ijsplt) , &282 & nlcjtl(ijsplt) , s_ctll(ijsplt) , v_ctll(ijsplt) )279 ALLOCATE( nis0allp(ijsplt) , nie0allp(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) , & 280 & njs0allp(ijsplt) , nje0allp(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) , & 281 & jpiallp(ijsplt) , t_ctll(ijsplt) , u_ctll(ijsplt) , & 282 & jpjallp(ijsplt) , s_ctll(ijsplt) , v_ctll(ijsplt) ) 283 283 284 284 ! Initialization … … 295 295 cl_run = 'MULTI processor run' 296 296 ! use indices for each area computed by mpp_init subroutine 297 n lditl(1:jpnij) = nldit(:)298 n leitl(1:jpnij) = nleit(:)299 n ldjtl(1:jpnij) = nldjt(:)300 n lejtl(1:jpnij) = nlejt(:)297 nis0allp(1:jpnij) = nis0all(:) 298 nie0allp(1:jpnij) = nie0all(:) 299 njs0allp(1:jpnij) = njs0all(:) 300 nje0allp(1:jpnij) = nje0all(:) 301 301 ! 302 302 nimpptl(1:jpnij) = nimppt(:) 303 303 njmpptl(1:jpnij) = njmppt(:) 304 304 ! 305 nlcitl(1:jpnij) = nlcit(:)306 nlcjtl(1:jpnij) = nlcjt(:)305 jpiallp(1:jpnij) = jpiall(:) 306 jpjallp(1:jpnij) = jpjall(:) 307 307 ! 308 308 ibonitl(1:jpnij) = ibonit(:) … … 335 335 ! Print the SUM control indices 336 336 IF( .NOT. lsp_area ) THEN 337 nictls = nimpptl(jn) + n lditl(jn) - 1338 nictle = nimpptl(jn) + n leitl(jn) - 1339 njctls = njmpptl(jn) + n ldjtl(jn) - 1340 njctle = njmpptl(jn) + n lejtl(jn) - 1337 nictls = nimpptl(jn) + nis0allp(jn) - 1 338 nictle = nimpptl(jn) + nie0allp(jn) - 1 339 njctls = njmpptl(jn) + njs0allp(jn) - 1 340 njctle = njmpptl(jn) + nje0allp(jn) - 1 341 341 ENDIF 342 342 WRITE(j_id,*) … … 344 344 WRITE(j_id,*) '~~~~~~~' 345 345 WRITE(j_id,*) 346 WRITE(j_id,9000)' nlej = ', nlejtl(jn), ' '346 WRITE(j_id,9000)' Nje0 = ', nje0allp(jn), ' ' 347 347 WRITE(j_id,9000)' ------------- njctle = ', njctle, ' -------------' 348 348 WRITE(j_id,9001)' | |' … … 350 350 WRITE(j_id,9001)' | |' 351 351 WRITE(j_id,9002)' nictls = ', nictls, ' nictle = ', nictle 352 WRITE(j_id,9002)' nldi = ', nlditl(jn), ' nlei = ', nleitl(jn)352 WRITE(j_id,9002)' Nis0 = ', nis0allp(jn), ' Nie0 = ', nie0allp(jn) 353 353 WRITE(j_id,9001)' | |' 354 354 WRITE(j_id,9001)' | |' 355 355 WRITE(j_id,9001)' | |' 356 356 WRITE(j_id,9004)' njmpp = ',njmpptl(jn),' ------------- njctls = ', njctls, ' -------------' 357 WRITE(j_id,9003)' nimpp = ', nimpptl(jn), ' nldj = ', nldjtl(jn), ' '357 WRITE(j_id,9003)' nimpp = ', nimpptl(jn), ' Njs0 = ', njs0allp(jn), ' ' 358 358 WRITE(j_id,*) 359 359 WRITE(j_id,*) … … 392 392 !! njmpp : latitudinal index 393 393 !! narea : number for local area 394 !! nlcil : first dimension395 !! nlcjl : second dimension394 !! ipil : first dimension 395 !! ipjl : second dimension 396 396 !! nbondil : mark for "east-west local boundary" 397 397 !! nbondjl : mark for "north-south local boundary" … … 408 408 ii, ij, & ! temporary integers 409 409 irestil, irestjl, & ! " " 410 ijpi , ijpj, nlcil,& ! temporary logical unit411 nlcjl , nbondil, nbondjl,&412 nrecil, nrecjl, nldil, nleil, nldjl, nlejl413 414 INTEGER, DIMENSION(jpi,jpj) :: iimpptl, ijmpptl, i lcitl, ilcjtl ! workspace410 ijpi , ijpj, ipil, & ! temporary logical unit 411 ipjl , nbondil, nbondjl, & 412 nrecil, nrecjl, Nis0l, Nie0l, Njs0l, Nje0l 413 414 INTEGER, DIMENSION(jpi,jpj) :: iimpptl, ijmpptl, ijpitl, ijpjtl ! workspace 415 415 REAL(wp) :: zidom, zjdom ! temporary scalars 416 416 INTEGER :: inum ! local logical unit … … 421 421 ! 1. Dimension arrays for subdomains 422 422 ! ----------------------------------- 423 ! Computation of local domain sizes i lcitl() ilcjtl()423 ! Computation of local domain sizes ijpitl() ijpjtl() 424 424 ! These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo 425 425 ! The subdomains are squares leeser than or equal to the global … … 448 448 DO jj = 1, jsplt 449 449 DO ji=1, isplt-1 450 i lcitl(ji,jj) = ijpi450 ijpitl(ji,jj) = ijpi 451 451 END DO 452 i lcitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil)452 ijpitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil) 453 453 END DO 454 454 … … 457 457 DO jj = 1, jsplt 458 458 DO ji = 1, irestil 459 i lcitl(ji,jj) = ijpi459 ijpitl(ji,jj) = ijpi 460 460 END DO 461 461 DO ji = irestil+1, isplt 462 i lcitl(ji,jj) = ijpi -1462 ijpitl(ji,jj) = ijpi -1 463 463 END DO 464 464 END DO … … 472 472 DO ji = 1, isplt 473 473 DO jj=1, jsplt-1 474 i lcjtl(ji,jj) = ijpj474 ijpjtl(ji,jj) = ijpj 475 475 END DO 476 i lcjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl)476 ijpjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl) 477 477 END DO 478 478 … … 481 481 DO ji = 1, isplt 482 482 DO jj = 1, irestjl 483 i lcjtl(ji,jj) = ijpj483 ijpjtl(ji,jj) = ijpj 484 484 END DO 485 485 DO jj = irestjl+1, jsplt 486 i lcjtl(ji,jj) = ijpj -1486 ijpjtl(ji,jj) = ijpj -1 487 487 END DO 488 488 END DO … … 491 491 zidom = nrecil 492 492 DO ji = 1, isplt 493 zidom = zidom + i lcitl(ji,1) - nrecil493 zidom = zidom + ijpitl(ji,1) - nrecil 494 494 END DO 495 495 IF(lwp) WRITE(numout,*) 496 IF(lwp) WRITE(numout,*)' sum i lcitl(i,1) = ', zidom, ' jpiglo = ', jpiglo496 IF(lwp) WRITE(numout,*)' sum ijpitl(i,1) = ', zidom, ' jpiglo = ', jpiglo 497 497 498 498 zjdom = nrecjl 499 499 DO jj = 1, jsplt 500 zjdom = zjdom + i lcjtl(1,jj) - nrecjl501 END DO 502 IF(lwp) WRITE(numout,*)' sum i lcitl(1,j) = ', zjdom, ' jpjglo = ', jpjglo500 zjdom = zjdom + ijpjtl(1,jj) - nrecjl 501 END DO 502 IF(lwp) WRITE(numout,*)' sum ijpitl(1,j) = ', zjdom, ' jpjglo = ', jpjglo 503 503 IF(lwp) WRITE(numout,*) 504 504 … … 513 513 DO jj = 1, jsplt 514 514 DO ji = 2, isplt 515 iimpptl(ji,jj) = iimpptl(ji-1,jj) + i lcitl(ji-1,jj) - nrecil515 iimpptl(ji,jj) = iimpptl(ji-1,jj) + ijpitl(ji-1,jj) - nrecil 516 516 END DO 517 517 END DO … … 521 521 DO jj = 2, jsplt 522 522 DO ji = 1, isplt 523 ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+i lcjtl(ji,jj-1)-nrecjl523 ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ijpjtl(ji,jj-1)-nrecjl 524 524 END DO 525 525 END DO … … 534 534 nimpptl(jn) = iimpptl(ii,ij) 535 535 njmpptl(jn) = ijmpptl(ii,ij) 536 nlcitl (jn) = ilcitl (ii,ij)537 nlcil = nlcitl(jn)538 nlcjtl (jn) = ilcjtl (ii,ij)539 nlcjl = nlcjtl(jn)536 jpiallp(jn) = ijpitl (ii,ij) 537 ipil = jpiallp(jn) 538 jpjallp(jn) = ijpjtl (ii,ij) 539 ipjl = jpjallp(jn) 540 540 nbondjl = -1 ! general case 541 541 IF( jn > isplt ) nbondjl = 0 ! first row of processor … … 550 550 ibonitl(jn) = nbondil 551 551 552 nldil = 1 + nn_hls553 nleil = nlcil - nn_hls554 IF( nbondil == -1 .OR. nbondil == 2 ) nldil = 1555 IF( nbondil == 1 .OR. nbondil == 2 ) nleil = nlcil556 nldjl = 1 + nn_hls557 nlejl = nlcjl - nn_hls558 IF( nbondjl == -1 .OR. nbondjl == 2 ) nldjl = 1559 IF( nbondjl == 1 .OR. nbondjl == 2 ) nlejl = nlcjl560 n lditl(jn) = nldil561 n leitl(jn) = nleil562 n ldjtl(jn) = nldjl563 n lejtl(jn) = nlejl552 Nis0l = 1 + nn_hls 553 Nie0l = ipil - nn_hls 554 IF( nbondil == -1 .OR. nbondil == 2 ) Nis0l = 1 555 IF( nbondil == 1 .OR. nbondil == 2 ) Nie0l = ipil 556 Njs0l = 1 + nn_hls 557 Nje0l = ipjl - nn_hls 558 IF( nbondjl == -1 .OR. nbondjl == 2 ) Njs0l = 1 559 IF( nbondjl == 1 .OR. nbondjl == 2 ) Nje0l = ipjl 560 nis0allp(jn) = Nis0l 561 nie0allp(jn) = Nie0l 562 njs0allp(jn) = Njs0l 563 nje0allp(jn) = Nje0l 564 564 END DO 565 565 ! … … 567 567 IF(lwp) THEN 568 568 CALL ctl_opn( inum, 'layout_prtctl.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 569 WRITE(inum,'(a)') 'nproc nlcil nlcjl nldil nldjl nleil nlejl nimpptl njmpptl ibonitl ibonjtl'569 WRITE(inum,'(a)') 'nproc ipil ipjl Nis0l Njs0l Nie0l Nje0l nimpptl njmpptl ibonitl ibonjtl' 570 570 ! 571 571 DO jn = 1, ijsplt 572 WRITE(inum,'(i5,6i6,4i8)') jn-1, nlcitl(jn), nlcjtl(jn), &573 & n lditl(jn), nldjtl(jn), &574 & n leitl(jn), nlejtl(jn), &575 & nimpptl(jn),njmpptl(jn), &576 & ibonitl(jn),ibonjtl(jn)572 WRITE(inum,'(i5,6i6,4i8)') jn-1, jpiallp(jn), jpjallp(jn), & 573 & nis0allp(jn), njs0allp(jn), & 574 & nie0allp(jn), nje0allp(jn), & 575 & nimpptl(jn), njmpptl(jn), & 576 & ibonitl(jn), ibonjtl(jn) 577 577 END DO 578 578 CLOSE(inum)
Note: See TracChangeset
for help on using the changeset viewer.
