Changeset 13130 for NEMO/branches
- Timestamp:
- 2020-06-19T08:18:11+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src
- Files:
-
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_interp.F90
r13065 r13130 1184 1184 IF( ABS( ptab(ji,jj) - glamt(ji,jj) ) > ztst ) THEN 1185 1185 WRITE(numout,*) ' Agrif error for glamt: parent, child, i, j ', ptab(ji,jj), glamt(ji,jj), mig0(ji), mig0(jj) 1186 kindic_agr = kindic_agr + 11186 ! kindic_agr = kindic_agr + 1 1187 1187 ENDIF 1188 1188 END DO … … 1213 1213 IF( ABS( ptab(ji,jj) - gphit(ji,jj) ) > ztst ) THEN 1214 1214 WRITE(numout,*) ' Agrif error for gphit: parent, child, i, j ', ptab(ji,jj), gphit(ji,jj), mig0(ji), mig0(jj) 1215 kindic_agr = kindic_agr + 11215 ! kindic_agr = kindic_agr + 1 1216 1216 ENDIF 1217 1217 END DO -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_user.F90
r13123 r13130 462 462 !--------------- 463 463 CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 464 !!$ CALL Agrif_Set_Updatetype(glamt_id, update = AGRIF_Update_Average)465 !!$ CALL Agrif_Set_Updatetype(gphit_id, update = AGRIF_Update_Average)466 464 467 465 # if defined UPD_HIGH -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DIA/diawri.F90
r13124 r13130 449 449 450 450 ! Define indices of the horizontal output zoom and vertical limit storage 451 iimi = 1 ; iima = jpi452 ijmi = 1 ; ijma = jpj451 iimi = Nis0 ; iima = Nie0 452 ijmi = Njs0 ; ijma = Nje0 453 453 ipk = jpk 454 454 IF(ln_abl) ipka = jpkam1 … … 457 457 it = kt 458 458 itmod = kt - nit000 + 1 459 460 459 461 460 ! 1. Define NETCDF files and fields at beginning of first time step -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domwri.F90
r12807 r13130 74 74 ! ! ============================ 75 75 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 76 !77 ! ! global domain size78 CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )79 CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )80 CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpkglo, wp), ktype = jp_i4 )81 82 76 ! ! domain characteristics 83 77 CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 ) -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/ICB/icbrst.F90
r13124 r13130 245 245 IF( lk_mpp ) THEN 246 246 ! Set domain parameters (assume jpdom_local_full) 247 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij )248 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number' , narea-1 )249 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1 , 2/) )250 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_global' , (/ jpiglo , jpjglo/) )251 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_local' , (/ Ni_0 , Nj_0/) )252 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig (Nis0), mjg(Njs0) /) )253 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_last' , (/ mig (Nie0), mjg(Nje0) /) )254 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0 , 0/) )255 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_end' , (/ 0 , 0/) )256 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_type' , 'BOX' )247 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij ) 248 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number' , narea-1 ) 249 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1 , 2 /) ) 250 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_global' , (/ Ni0glo , Nj0glo /) ) 251 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_local' , (/ Ni_0 , Nj_0 /) ) 252 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig0(Nis0), mjg0(Njs0) /) ) 253 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_last' , (/ mig0(Nie0), mjg0(Nje0) /) ) 254 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0 , 0 /) ) 255 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_end' , (/ 0 , 0 /) ) 256 nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_type' , 'BOX' ) 257 257 ENDIF 258 258 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom.F90
r12960 r13130 94 94 CONTAINS 95 95 96 SUBROUTINE iom_init( cdname, fname, ld_ tmppatch, ld_closedef )96 SUBROUTINE iom_init( cdname, fname, ld_closedef ) 97 97 !!---------------------------------------------------------------------- 98 98 !! *** ROUTINE *** … … 103 103 CHARACTER(len=*), INTENT(in) :: cdname 104 104 CHARACTER(len=*), OPTIONAL, INTENT(in) :: fname 105 LOGICAL , OPTIONAL, INTENT(in) :: ld_tmppatch106 105 LOGICAL , OPTIONAL, INTENT(in) :: ld_closedef 107 106 #if defined key_iomput … … 116 115 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 117 116 REAL(wp), DIMENSION(2,jpkam1) :: za_bnds ! ABL vertical boundaries 118 LOGICAL :: ll_tmppatch = .TRUE. !: seb: patch before we remove periodicity119 INTEGER :: Nis0_save, Nie0_save !: and close boundaries in output files120 INTEGER :: Njs0_save, Nje0_save !:121 INTEGER :: Ni_0_save, Nj_0_save !:122 117 LOGICAL :: ll_closedef = .TRUE. 123 118 !!---------------------------------------------------------------------- 124 119 ! 125 ! seb: patch before we remove periodicity and close boundaries in output files126 IF( PRESENT(ld_tmppatch) ) THEN ; ll_tmppatch = ld_tmppatch127 ELSE ; ll_tmppatch = .TRUE.128 ENDIF129 IF ( ll_tmppatch ) THEN130 Nis0_save = Nis0 ; Nie0_save = Nie0131 Njs0_save = Njs0 ; Nje0_save = Nje0132 Ni_0_save = Ni_0 ; Nj_0_save = Nj_0133 IF( mig( 1 ) == 1 ) Nis0 = 1134 IF( mig(jpi) == jpiglo ) Nie0 = jpi135 IF( mjg( 1 ) == 1 ) Njs0 = 1136 IF( mjg(jpj) == jpjglo ) Nje0 = jpj137 Ni_0 = Nie0 - Nis0 + 1138 Nj_0 = Nje0 - Njs0 + 1139 ENDIF140 120 IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef 141 121 ! … … 285 265 DEALLOCATE( zt_bnds, zw_bnds ) 286 266 ! 287 IF ( ll_tmppatch ) THEN288 Nis0 = Nis0_save ; Nie0 = Nie0_save289 Njs0 = Njs0_save ; Nje0 = Nje0_save290 Ni_0 = Ni_0_save ; Nj_0 = Nj_0_save291 ENDIF292 267 #endif 293 268 ! … … 695 670 INTEGER :: iln, ils ! lengths of character 696 671 INTEGER :: istop ! 697 INTEGER, DIMENSION(2,5) :: idompar ! domain parameters:698 672 ! local number of points for x,y dimensions 699 673 ! position of first local point for x,y dimensions … … 765 739 ELSE 766 740 lxios_sini = .TRUE. 767 ENDIF768 IF( llwrt ) THEN769 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 /)774 741 ENDIF 775 742 ! Open the NetCDF file … … 796 763 ENDIF 797 764 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 ) 799 766 ENDIF 800 767 ! … … 1654 1621 CHARACTER(LEN=*) , INTENT(in) :: cdname 1655 1622 REAL(wp), DIMENSION(:,:), INTENT(in) :: pfield2d 1623 IF( iom_use(cdname) ) THEN 1656 1624 #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 1658 1630 #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 1661 1634 END SUBROUTINE iom_p2d 1662 1635 … … 1664 1637 CHARACTER(LEN=*) , INTENT(in) :: cdname 1665 1638 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pfield3d 1639 IF( iom_use(cdname) ) THEN 1666 1640 #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 1668 1646 #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 1671 1650 END SUBROUTINE iom_p3d 1672 1651 … … 1674 1653 CHARACTER(LEN=*) , INTENT(in) :: cdname 1675 1654 REAL(wp), DIMENSION(:,:,:,:), INTENT(in) :: pfield4d 1655 IF( iom_use(cdname) ) THEN 1676 1656 #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 1678 1662 #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 1681 1666 END SUBROUTINE iom_p4d 1682 1667 … … 1875 1860 !!---------------------------------------------------------------------- 1876 1861 ! 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) 1879 1864 !don't define lon and lat for restart reading context. 1880 1865 IF ( .NOT.ldrxios ) & … … 1886 1871 SELECT CASE ( cdgrd ) 1887 1872 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,:) 1890 1875 CASE('W') ; zmask(:,:,2:jpk ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk) ; zmask(:,:,1) = tmask(:,:,1) 1891 1876 END SELECT … … 1930 1915 ! 1931 1916 ! 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(:,:) 1958 1933 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 1993 1935 ! 1994 1936 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)), & … … 2017 1959 ! CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots) 2018 1960 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) 2021 1963 CALL iom_set_domain_attr("gznl", lonvalue = zlon, & 2022 1964 & 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) 2024 1966 ! 2025 1967 CALL iom_update_file_name('ptr') … … 2098 2040 ! Equatorial section (attributs: jbegin, ni, name_suffix) 2099 2041 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 ) 2101 2043 CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff ) 2102 2044 CALL iom_set_file_attr ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom_def.F90
r13124 r13130 13 13 PRIVATE 14 14 15 INTEGER, PARAMETER, PUBLIC :: jpdom_global = 1 !: ( 1 : jpiglo, 1 :jpjglo)15 INTEGER, PARAMETER, PUBLIC :: jpdom_global = 1 !: ( 1 :Ni0glo, 1 :Nj0glo) 16 16 INTEGER, PARAMETER, PUBLIC :: jpdom_local = 2 !: (Nis0: Nie0 ,Njs0: Nje0 ) 17 17 INTEGER, PARAMETER, PUBLIC :: jpdom_unknown = 3 !: No dimension checking -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom_nf90.F90
r13015 r13130 46 46 CONTAINS 47 47 48 SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kd ompar, kdlev, cdcomp )48 SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdlev, cdcomp ) 49 49 !!--------------------------------------------------------------------- 50 50 !! *** SUBROUTINE iom_open *** … … 56 56 LOGICAL , INTENT(in ) :: ldwrt ! read or write the file? 57 57 LOGICAL , INTENT(in ) :: ldok ! check the existence 58 INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters:59 58 INTEGER , INTENT(in ), OPTIONAL :: kdlev ! size of the ice/abl third dimension 60 59 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cdcomp ! name of component calling iom_nf90_open … … 133 132 CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy ), clinfo) 134 133 ! define dimensions 135 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1), idmy ), clinfo)136 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1), idmy ), clinfo)134 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', Ni_0, idmy ), clinfo) 135 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', Nj_0, idmy ), clinfo) 137 136 SELECT CASE (clcomp) 138 CASE ('OCE') ; CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', 139 CASE ('ICE') ; CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numcat', 140 CASE ('ABL') ; CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', 141 CASE ('SED') ; CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numsed', 137 CASE ('OCE') ; CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', jpk, idmy ), clinfo) 138 CASE ('ICE') ; CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numcat', kdlev, idmy ), clinfo) 139 CASE ('ABL') ; CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', kdlev, idmy ), clinfo) 140 CASE ('SED') ; CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numsed', kdlev, idmy ), clinfo) 142 141 CASE DEFAULT ; CALL ctl_stop( 'iom_nf90_open unknown component type' ) 143 142 END SELECT 144 143 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 145 144 ! global attributes 146 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij ), clinfo)147 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number' , narea-1 ), clinfo)148 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1 , 2/) ), clinfo)149 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global' , (/ jpiglo, jpjglo/) ), clinfo)150 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local' , kdompar(:,1)), clinfo)151 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , kdompar(:,2)), clinfo)152 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last' , kdompar(:,3)), clinfo)153 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', kdompar(:,4)), clinfo)154 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end' , kdompar(:,5)), clinfo)155 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type' , 'BOX' ), clinfo)145 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij ), clinfo) 146 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number' , narea-1 ), clinfo) 147 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1 , 2 /) ), clinfo) 148 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global' , (/ Ni0glo , Nj0glo /) ), clinfo) 149 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local' , (/ Ni_0 , Nj_0 /) ), clinfo) 150 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig0(Nis0), mjg0(Njs0) /) ), clinfo) 151 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last' , (/ mig0(Nie0), mjg0(Nje0) /) ), clinfo) 152 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0 , 0 /) ), clinfo) 153 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end' , (/ 0 , 0 /) ), clinfo) 154 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type' , 'BOX' ), clinfo) 156 155 ELSE !* the file should be open for read mode so it must exist... 157 156 CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' ) -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/restart.F90
r12738 r13130 214 214 IF( .NOT.lxios_set ) THEN 215 215 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS' 216 CALL iom_init( crxios_context , ld_tmppatch = .false.)216 CALL iom_init( crxios_context ) 217 217 lxios_set = .TRUE. 218 218 ENDIF 219 219 ENDIF 220 220 IF( TRIM(Agrif_CFixed()) /= '0' .AND. lrxios) THEN 221 CALL iom_init( crxios_context , ld_tmppatch = .false.)221 CALL iom_init( crxios_context ) 222 222 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for AGRIF' 223 223 lxios_set = .TRUE. -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mppini.F90
r13065 r13130 1200 1200 ! Set idompar values equivalent to the jpdom_local_noextra definition 1201 1201 ! used in IOM. This works even if jpnij .ne. jpni*jpnj. 1202 iglo(1) = jpiglo 1203 iglo(2) = jpjglo 1204 iloc(1) = jpi 1205 iloc(2) = jpj 1206 iabsf(1) = nimppt(narea) 1207 iabsf(2) = njmppt(narea) 1202 iglo( :) = (/ Ni0glo, Nj0glo /) 1203 iloc( :) = (/ Ni_0 , Nj_0 /) 1204 iabsf(:) = (/ Nis0 , Njs0 /) + (/ nimpp, njmpp /) - 1 - nn_hls ! corresponds to mig0(Nis0) but mig0 is not yet defined! 1208 1205 iabsl(:) = iabsf(:) + iloc(:) - 1 1209 ihals(1) = Nis0 - 1 1210 ihals(2) = Njs0 - 1 1211 ihale(1) = jpi - Nie0 1212 ihale(2) = jpj - Nje0 1213 idid(1) = 1 1214 idid(2) = 2 1206 ihals(:) = (/ 0 , 0 /) 1207 ihale(:) = (/ 0 , 0 /) 1208 idid( :) = (/ 1 , 2 /) 1215 1209 1216 1210 IF(lwp) THEN 1217 1211 WRITE(numout,*) 1218 WRITE(numout,*) 'mpp init_ioipsl : iloc = ', iloc (1), iloc (2)1219 WRITE(numout,*) '~~~~~~~~~~~~~~~ iabsf = ', iabsf (1), iabsf(2)1220 WRITE(numout,*) ' ihals = ', ihals (1), ihals(2)1221 WRITE(numout,*) ' ihale = ', ihale (1), ihale(2)1212 WRITE(numout,*) 'mpp init_ioipsl : iloc = ', iloc 1213 WRITE(numout,*) '~~~~~~~~~~~~~~~ iabsf = ', iabsf 1214 WRITE(numout,*) ' ihals = ', ihals 1215 WRITE(numout,*) ' ihale = ', ihale 1222 1216 ENDIF 1223 1217 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/cpl_oasis3.F90
r12807 r13130 69 69 INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 70 70 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields 71 LOGICAL, PARAMETER :: ltmp_wapatch = .TRUE. ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define72 INTEGER :: Nis0_save, Nie0_save73 INTEGER :: Njs0_save, Nje0_save74 71 75 72 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information … … 148 145 !!-------------------------------------------------------------------- 149 146 150 ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define151 IF( ltmp_wapatch ) THEN152 Nis0_save = Nis0 ; Nie0_save = Nie0153 Njs0_save = Njs0 ; Nje0_save = Nje0154 IF( nimpp == 1 ) Nis0 = 1155 IF( nimpp + jpi - 1 == jpiglo ) Nie0 = jpi156 IF( njmpp == 1 ) Njs0 = 1157 IF( njmpp + jpj - 1 == jpjglo ) Nje0 = jpj158 ENDIF159 147 IF(lwp) WRITE(numout,*) 160 148 IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case' … … 316 304 #endif 317 305 ! 318 IF( ltmp_wapatch ) THEN319 Nis0 = Nis0_save ; Nie0 = Nie0_save320 Njs0 = Njs0_save ; Nje0 = Nje0_save321 ENDIF322 306 END SUBROUTINE cpl_define 323 307 … … 337 321 INTEGER :: jc,jm ! local loop index 338 322 !!-------------------------------------------------------------------- 339 ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define340 IF( ltmp_wapatch ) THEN341 Nis0_save = Nis0 ; Nie0_save = Nie0342 Njs0_save = Njs0 ; Nje0_save = Nje0343 IF( nimpp == 1 ) Nis0 = 1344 IF( nimpp + jpi - 1 == jpiglo ) Nie0 = jpi345 IF( njmpp == 1 ) Njs0 = 1346 IF( njmpp + jpj - 1 == jpjglo ) Nje0 = jpj347 ENDIF348 323 ! 349 324 ! snd data to OASIS3 … … 374 349 ENDDO 375 350 ENDDO 376 IF( ltmp_wapatch ) THEN377 Nis0 = Nis0_save ; Nie0 = Nie0_save378 Njs0 = Njs0_save ; Nje0 = Nje0_save379 ENDIF380 351 ! 381 352 END SUBROUTINE cpl_snd … … 396 367 !! 397 368 INTEGER :: jc,jm ! local loop index 398 LOGICAL :: llaction, ll fisrt369 LOGICAL :: llaction, ll_1st 399 370 !!-------------------------------------------------------------------- 400 ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define401 IF( ltmp_wapatch ) THEN402 Nis0_save = Nis0 ; Nie0_save = Nie0403 Njs0_save = Njs0 ; Nje0_save = Nje0404 ENDIF405 371 ! 406 372 ! receive local data from OASIS3 on every process … … 409 375 ! 410 376 DO jc = 1, srcv(kid)%nct 411 IF( ltmp_wapatch ) THEN 412 IF( nimpp == 1 ) Nis0 = 1 413 IF( nimpp + jpi - 1 == jpiglo ) Nie0 = jpi 414 IF( njmpp == 1 ) Njs0 = 1 415 IF( njmpp + jpj - 1 == jpjglo ) Nje0 = jpj 416 ENDIF 417 llfisrt = .TRUE. 377 ll_1st = .TRUE. 418 378 419 379 DO jm = 1, srcv(kid)%ncplmodel … … 431 391 432 392 kinfo = OASIS_Rcv 433 IF( ll fisrt ) THEN393 IF( ll_1st ) THEN 434 394 pdata(Nis0:Nie0,Njs0:Nje0,jc) = exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 435 ll fisrt = .FALSE.395 ll_1st = .FALSE. 436 396 ELSE 437 397 pdata(Nis0:Nie0,Njs0:Nje0,jc) = pdata(Nis0:Nie0,Njs0:Nje0,jc) & … … 457 417 ENDDO 458 418 459 IF( ltmp_wapatch ) THEN460 Nis0 = Nis0_save ; Nie0 = Nie0_save461 Njs0 = Njs0_save ; Nje0 = Nje0_save462 ENDIF463 419 !--- Fill the overlap areas and extra hallows (mpp) 464 420 !--- check periodicity conditions (all cases) 465 IF( . not. llfisrt ) THEN421 IF( .NOT. ll_1st ) THEN 466 422 CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 467 423 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.