- Timestamp:
- 2021-11-28T18:59:49+01:00 (3 years ago)
- Location:
- NEMO/branches/2021/ticket2632_r14588_theta_sbcblk
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/NST/agrif_user.F90 (modified) (26 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette@14244 sette 11 ^/utils/CI/sette@HEAD sette 12
-
- Property svn:externals
-
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/NST/agrif_user.F90
r14433 r15548 57 57 ! 58 58 INTEGER :: ind1, ind2, ind3, imaxrho 59 INTEGER :: nbghostcellsfine_tot_x, nbghostcellsfine_tot_y 59 60 INTEGER :: its 60 61 External :: nemo_mapping … … 63 64 ! In case of East-West periodicity, prevent AGRIF interpolation at east and west boundaries 64 65 ! The procnames will not be called at these boundaries 65 IF ( l_Iperio) THEN66 IF ( .NOT. lk_west ) THEN 66 67 CALL Agrif_Set_NearCommonBorderX(.TRUE.) 68 ENDIF 69 70 IF ( .NOT. lk_east ) THEN 67 71 CALL Agrif_Set_DistantCommonBorderX(.TRUE.) 68 72 ENDIF … … 78 82 ! 1. Declaration of the type of variable which have to be interpolated 79 83 !--------------------------------------------------------------------- 80 ind1 = nbghostcells 81 ind2 = nn_hls + 2 + nbghostcells_x 82 ind3 = nn_hls + 2 + nbghostcells_y_s 84 ! ind1 = nbghostcells 85 ind2 = nn_hls + 1 + nbghostcells_x_w 86 ind3 = nn_hls + 1 + nbghostcells_y_s 87 nbghostcellsfine_tot_x = MAX(nbghostcells_x_w,nbghostcells_x_e)+1 88 nbghostcellsfine_tot_y = MAX(nbghostcells_y_s,nbghostcells_y_n)+1 89 ind1 = MAX(nbghostcellsfine_tot_x, nbghostcellsfine_tot_y) 83 90 imaxrho = MAX(Agrif_irhox(), Agrif_irhoy()) 84 91 … … 120 127 ! 3. Location of interpolation 121 128 !----------------------------- 122 ! CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*imaxrho,ind1-1/) ) 123 ! JC: check near the boundary only until matching in sponge has been sorted out: 124 CALL Agrif_Set_bc( e3t_id, (/0,ind1-1/) ) 129 CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) ) 125 130 126 131 ! extend the interpolation zone by 1 more point than necessary: 127 132 ! RB check here 128 CALL Agrif_Set_bc( e3t0_interp_id, (/-nn_sponge_len*imaxrho-2,ind1/) ) 129 CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*imaxrho-2,ind1/) ) 130 CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*imaxrho-2,ind1/) ) 133 CALL Agrif_Set_bc( e3t0_interp_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) ) 134 CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) ) 135 CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) ) 136 131 137 CALL Agrif_Set_bc( tsini_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4 132 138 CALL Agrif_Set_bc( uini_id, (/0,ind1-1/) ) … … 142 148 #endif 143 149 144 !CALL Agrif_Set_ExternalMapping(nemo_mapping)150 CALL Agrif_Set_ExternalMapping(nemo_mapping) 145 151 ! 146 152 END SUBROUTINE agrif_declare_var_ini … … 222 228 ! 223 229 ! Build "intermediate" parent vertical grid on child domain 224 IF ( ln_vert_remap ) THEN 225 226 jpk_parent = Agrif_parent( jpk ) 227 ALLOCATE(e3t0_parent(jpi,jpj,jpk_parent), & 228 & e3u0_parent(jpi,jpj,jpk_parent), & 229 & e3v0_parent(jpi,jpj,jpk_parent), STAT = ierr) 230 IF( ierr > 0 ) CALL ctl_warn('Agrif_Init_Domain: allocation of arrays failed') 230 jpk_parent = Agrif_parent( jpk ) 231 ALLOCATE(e3t0_parent(jpi,jpj,jpk_parent), & 232 & e3u0_parent(jpi,jpj,jpk_parent), & 233 & e3v0_parent(jpi,jpj,jpk_parent), STAT = ierr) 234 IF( ierr > 0 ) CALL ctl_warn('Agrif_Init_Domain: allocation of arrays failed') 231 235 232 ! Retrieve expected parent scale factors on child grid: 233 Agrif_UseSpecialValue = .FALSE. 234 e3t0_parent(:,:,:) = 0._wp 235 CALL Agrif_Init_Variable(e3t0_interp_id, procname=interpe3t0_vremap) 236 ! 237 ! Deduce scale factors at U and V points: 238 DO_3D( 0, 0, 0, 0, 1, jpk_parent ) 239 e3u0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji+1,jj ,jk)) 240 e3v0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji ,jj+1,jk)) 241 END_3D 242 243 ! Assume a step at the bottom except if (pure) s-coordinates 244 IF ( .NOT.Agrif_Parent(ln_sco) ) THEN 245 DO_2D( 1, 0, 1, 0 ) 246 jk = mbku_parent(ji,jj) 247 e3u0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji+1,jj ,jk)) 248 jk = mbkv_parent(ji,jj) 249 e3v0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji ,jj+1,jk)) 250 END_2D 251 ENDIF 252 253 CALL lbc_lnk( 'Agrif_Init_Domain', e3u0_parent, 'U', 1.0_wp, e3v0_parent, 'V', 1.0_wp ) 254 ENDIF 236 ! Retrieve expected parent scale factors on child grid: 237 Agrif_UseSpecialValue = .FALSE. 238 e3t0_parent(:,:,:) = 0._wp 239 CALL Agrif_Init_Variable(e3t0_interp_id, procname=interpe3t0_vremap) 240 ! 241 ! Deduce scale factors at U and V points: 242 DO_3D( 0, 0, 0, 0, 1, jpk_parent ) 243 e3u0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji+1,jj ,jk)) 244 e3v0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji ,jj+1,jk)) 245 END_3D 246 247 ! Assume a step at the bottom except if (pure) s-coordinates 248 IF ( .NOT.Agrif_Parent(ln_sco) ) THEN 249 DO_2D( 1, 0, 1, 0 ) 250 jk = mbku_parent(ji,jj) 251 e3u0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji+1,jj ,jk)) 252 jk = mbkv_parent(ji,jj) 253 e3v0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji ,jj+1,jk)) 254 END_2D 255 ENDIF 256 257 CALL lbc_lnk( 'Agrif_Init_Domain', e3u0_parent, 'U', 1.0_wp, e3v0_parent, 'V', 1.0_wp ) 255 258 256 259 ! check if masks and bathymetries match … … 262 265 ! 263 266 kindic_agr = 0 264 IF( .NOT. ln_vert_remap ) THEN 265 ! 266 ! check if tmask and vertical scale factors agree with parent in sponge area: 267 CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 268 ! 269 ELSE 270 ! 271 ! In case of vertical interpolation, check only that total depths agree between child and parent: 272 273 CALL Agrif_check_bat( kindic_agr ) 274 ENDIF 267 ! 268 CALL Agrif_check_bat( kindic_agr ) 275 269 ! 276 270 CALL mpp_sum( 'agrif_InitValues_Domain', kindic_agr ) … … 287 281 WHERE (ssmask(:,:) == 0._wp) mbkt_parent(:,:) = 0 288 282 ! 283 IF ( .NOT.ln_vert_remap ) DEALLOCATE(e3t0_parent, e3u0_parent, e3v0_parent) 284 289 285 END SUBROUTINE Agrif_Init_Domain 290 286 … … 324 320 Agrif_UseSpecialValue = .TRUE. 325 321 l_vremap = ln_vert_remap 326 327 322 CALL Agrif_Bc_variable(ts_interp_id,calledweight=1.,procname=interptsn) 328 323 CALL Agrif_Sponge … … 439 434 ! 1. Declaration of the type of variable which have to be interpolated 440 435 !--------------------------------------------------------------------- 441 ind1 = nbghostcells 442 ind2 = nn_hls + 2 + nbghostcells_x443 ind3 = nn_hls + 2+ nbghostcells_y_s436 ind1 = nbghostcells - 1 ! Remove one land cell in ghosts 437 ind2 = nn_hls + 1 + nbghostcells_x_w 438 ind3 = nn_hls + 1 + nbghostcells_y_s 444 439 imaxrho = MAX(Agrif_irhox(), Agrif_irhoy()) 445 440 … … 624 619 USE Agrif_Util 625 620 USE ice 626 USE par_oce, ONLY : nbghostcells, nbghostcells_x , nbghostcells_y_s621 USE par_oce, ONLY : nbghostcells, nbghostcells_x_w, nbghostcells_y_s 627 622 ! 628 623 IMPLICIT NONE … … 639 634 ! 2,2 = two ghost lines 640 635 !------------------------------------------------------------------------------------- 641 ind1 = nbghostcells 642 ind2 = nn_hls + 2 + nbghostcells_x643 ind3 = nn_hls + 2+ nbghostcells_y_s636 ind1 = nbghostcells - 1 ! Remove one land cell in ghosts 637 ind2 = nn_hls + 1 + nbghostcells_x_w 638 ind3 = nn_hls + 1 + nbghostcells_y_s 644 639 ipl = jpl*(9+nlay_s+nlay_i) 645 640 CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_ice_id) … … 666 661 ! 3. Set location of interpolations 667 662 !---------------------------------- 668 CALL Agrif_Set_bc(tra_ice_id,(/0,ind1 /))669 CALL Agrif_Set_bc(u_ice_id ,(/0,ind1 /))670 CALL Agrif_Set_bc(v_ice_id ,(/0,ind1 /))671 672 CALL Agrif_Set_bc(tra_iceini_id,(/0,ind1 /))673 CALL Agrif_Set_bc(u_iceini_id ,(/0,ind1 /))674 CALL Agrif_Set_bc(v_iceini_id ,(/0,ind1 /))663 CALL Agrif_Set_bc(tra_ice_id,(/0,ind1-1/)) 664 CALL Agrif_Set_bc(u_ice_id ,(/0,ind1-1/)) 665 CALL Agrif_Set_bc(v_ice_id ,(/0,ind1-1/)) 666 667 CALL Agrif_Set_bc(tra_iceini_id,(/0,ind1-1/)) 668 CALL Agrif_Set_bc(u_iceini_id ,(/0,ind1-1/)) 669 CALL Agrif_Set_bc(v_iceini_id ,(/0,ind1-1/)) 675 670 676 671 ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) … … 696 691 !!---------------------------------------------------------------------- 697 692 USE Agrif_Util 693 USE agrif_oce 698 694 USE oce 699 695 USE dom_oce … … 722 718 Agrif_SpecialValue=0._wp 723 719 Agrif_UseSpecialValue = .TRUE. 720 l_vremap = ln_vert_remap 724 721 CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 725 Agrif_UseSpecialValue = .FALSE.726 722 CALL Agrif_Sponge 727 723 tabspongedone_trn = .FALSE. 728 724 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 725 Agrif_UseSpecialValue = .FALSE. 726 l_vremap = .FALSE. 729 727 ! reset tsa to zero 730 728 tr(:,:,:,:,Krhs_a) = 0._wp … … 758 756 nitend = Agrif_Parent(nitend) *Agrif_IRhot() 759 757 ENDIF 758 759 ! 760 IF (Agrif_Parent(ln_top_euler).OR.ln_top_euler) THEN 761 CALL ctl_stop( 'AGRIF and ln_top_euler=T not implemented') 762 ENDIF 760 763 ENDIF 761 764 ! … … 779 782 ! 1. Declaration of the type of variable which have to be interpolated 780 783 !--------------------------------------------------------------------- 781 ind1 = nbghostcells 782 ind2 = nn_hls + 2 + nbghostcells_x783 ind3 = nn_hls + 2+ nbghostcells_y_s784 ind1 = nbghostcells - 1 ! Remove one land cell in ghosts 785 ind2 = nn_hls + 1 + nbghostcells_x_w 786 ind3 = nn_hls + 1 + nbghostcells_y_s 784 787 imaxrho = MAX(Agrif_irhox(), Agrif_irhoy()) 785 788 … … 835 838 ! 836 839 INTEGER :: ios ! Local integer output status for namelist read 840 INTEGER :: imin, imax, jmin, jmax 837 841 NAMELIST/namagrif/ ln_agrif_2way, ln_init_chfrpar, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, & 838 842 & ln_spc_dyn, ln_vert_remap, ln_chk_bathy 839 843 !!-------------------------------------------------------------------------------------- 840 844 ! 841 READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 845 IF ( .NOT.Agrif_Root() ) THEN 846 ! 847 READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 842 848 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist' ) 843 READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )849 READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 844 850 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist' ) 845 IF(lwm) WRITE ( numond, namagrif ) 846 ! 847 IF(lwp) THEN ! control print 848 WRITE(numout,*) 849 WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters' 850 WRITE(numout,*) '~~~~~~~~~~~~~~~' 851 WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters' 852 WRITE(numout,*) ' Two way nesting activated ln_agrif_2way = ', ln_agrif_2way 853 WRITE(numout,*) ' child initial state from parent ln_init_chfrpar = ', ln_init_chfrpar 854 WRITE(numout,*) ' ad. sponge coeft for tracers rn_sponge_tra = ', rn_sponge_tra 855 WRITE(numout,*) ' ad. sponge coeft for dynamics rn_sponge_tra = ', rn_sponge_dyn 856 WRITE(numout,*) ' ad. time relaxation for tracers rn_trelax_tra = ', rn_trelax_tra 857 WRITE(numout,*) ' ad. time relaxation for dynamics rn_trelax_dyn = ', rn_trelax_dyn 858 WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn 859 WRITE(numout,*) ' vertical remapping ln_vert_remap = ', ln_vert_remap 860 WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy 861 ENDIF 862 863 ! JC => side effects of lines below to be checked: 864 lk_west = .NOT. ( Agrif_Ix() == 1 ) 865 lk_east = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(Ni0glo) -1 ) 866 lk_south = .NOT. ( Agrif_Iy() == 1 ) 867 lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(Nj0glo) -1 ) 868 ! 869 ! Set the number of ghost cells according to periodicity 870 nbghostcells_x = nbghostcells 851 IF(lwm) WRITE ( numond, namagrif ) 852 ! 853 IF(lwp) THEN ! control print 854 WRITE(numout,*) 855 WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters' 856 WRITE(numout,*) '~~~~~~~~~~~~~~~' 857 WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters' 858 WRITE(numout,*) ' Two way nesting activated ln_agrif_2way = ', ln_agrif_2way 859 WRITE(numout,*) ' child initial state from parent ln_init_chfrpar = ', ln_init_chfrpar 860 WRITE(numout,*) ' ad. sponge coeft for tracers rn_sponge_tra = ', rn_sponge_tra 861 WRITE(numout,*) ' ad. sponge coeft for dynamics rn_sponge_tra = ', rn_sponge_dyn 862 WRITE(numout,*) ' ad. time relaxation for tracers rn_trelax_tra = ', rn_trelax_tra 863 WRITE(numout,*) ' ad. time relaxation for dynamics rn_trelax_dyn = ', rn_trelax_dyn 864 WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn 865 WRITE(numout,*) ' vertical remapping ln_vert_remap = ', ln_vert_remap 866 WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy 867 ENDIF 868 869 imin = Agrif_Ix() 870 imax = Agrif_Ix() + nbcellsx/AGRIF_Irhox() 871 jmin = Agrif_Iy() 872 jmax = Agrif_Iy() + nbcellsy/AGRIF_Irhoy() 873 lk_west = .TRUE. ; lk_east = .TRUE. 874 lk_north = .TRUE. ; lk_south = .TRUE. 875 876 ! Check zoom position along i: 877 ! ---------------------------- 878 IF ( imin >= imax ) THEN 879 CALL ctl_stop( 'STOP', 'AGRIF zoom imin must be < imax' ) 880 ENDIF 881 882 IF ( Agrif_Parent(l_Iperio) ) THEN 883 IF ( l_Iperio ) THEN ! Cyclic east-west zoom 884 lk_west = .FALSE. ; lk_east = .FALSE. 885 ! Checks: 886 IF ( imin/=1-Agrif_Parent(nbghostcells_x_w) ) THEN 887 WRITE(ctmp1, 9000) ' AGRIF zoom is East-West cyclic, imin must = ', & 888 1 - Agrif_Parent(nbghostcells_x_w) 889 CALL ctl_stop( 'STOP', ctmp1 ) 890 ENDIF 891 IF ( imax/=Agrif_Parent(Ni0glo)+1-Agrif_Parent(nbghostcells_x_w)) THEN 892 WRITE(ctmp1, 9000) ' AGRIF zoom is East-West cyclic, imax must = ', & 893 Agrif_Parent(Ni0glo) + 1 - Agrif_Parent(nbghostcells_x_w) 894 CALL ctl_stop( 'STOP', ctmp1 ) 895 ENDIF 896 ELSE 897 IF ( imax>Agrif_Parent(Ni0glo)-Agrif_Parent(nbghostcells_x_w)) THEN 898 WRITE(ctmp1, 9000) ' AGRIF zoom imax must be <= ', & 899 Agrif_Parent(Ni0glo) - Agrif_Parent(nbghostcells_x_w) 900 CALL ctl_stop( 'STOP', ctmp1 ) 901 ENDIF 902 ENDIF 903 ELSE 904 IF ( imin<2-Agrif_Parent(nbghostcells_x_w) ) THEN 905 WRITE(ctmp1, 9000) ' AGRIF zoom imin must be >= ', & 906 2 - Agrif_Parent(nbghostcells_x_w) 907 CALL ctl_stop( 'STOP', ctmp1 ) 908 ENDIF 909 IF ( imax>Agrif_Parent(Ni0glo)-Agrif_Parent(nbghostcells_x_w)) THEN 910 WRITE(ctmp1, 9000) ' AGRIF zoom imax must be <= ', & 911 Agrif_Parent(Ni0glo) - Agrif_Parent(nbghostcells_x_w) 912 CALL ctl_stop( 'STOP', ctmp1 ) 913 ENDIF 914 IF ( imin==2-Agrif_Parent(nbghostcells_x_w) ) lk_west = .FALSE. 915 IF ( imax==Agrif_Parent(Ni0glo)-Agrif_Parent(nbghostcells_x_w) ) lk_east = .FALSE. 916 ENDIF 917 918 ! Check zoom position along j: 919 ! ---------------------------- 920 IF ( jmin >= jmax ) THEN 921 CALL ctl_stop( 'STOP', 'AGRIF zoom jmin must be < jmax' ) 922 ENDIF 923 924 IF ( Agrif_Parent(l_NFold) ) THEN 925 IF ( l_NFold ) THEN ! North-Fold 926 lk_north = .FALSE. 927 ! Checks: 928 IF ( jmax/=Agrif_Parent(Nj0glo)+1-Agrif_Parent(nbghostcells_y_s)) THEN 929 WRITE(ctmp1, 9000) ' AGRIF zoom has a North-Fold, jmax must = ', & 930 Agrif_Parent(Nj0glo) + 1 - Agrif_Parent(nbghostcells_y_s) 931 CALL ctl_stop( 'STOP', ctmp1 ) 932 ENDIF 933 ENDIF 934 ELSE 935 IF ( jmax>Agrif_Parent(Nj0glo)-Agrif_Parent(nbghostcells_y_s)) THEN 936 WRITE(ctmp1, 9000) ' AGRIF zoom jmax must be <= ', & 937 Agrif_Parent(Nj0glo) - Agrif_Parent(nbghostcells_y_s) 938 CALL ctl_stop( 'STOP', ctmp1 ) 939 ENDIF 940 IF ( jmax==Agrif_Parent(Nj0glo)-Agrif_Parent(nbghostcells_y_s) ) lk_north = .FALSE. 941 ENDIF 942 943 IF ( jmin<2-Agrif_Parent(nbghostcells_y_s)) THEN 944 WRITE(ctmp1, 9000) ' AGRIF zoom jmin must be >= ', & 945 2 - Agrif_Parent(nbghostcells_y_s) 946 CALL ctl_stop( 'STOP', ctmp1 ) 947 ENDIF 948 IF ( jmin==2-Agrif_Parent(nbghostcells_y_s) ) lk_south = .FALSE. 949 950 ELSE ! Root grid 951 lk_west = .FALSE. ; lk_east = .FALSE. 952 lk_north = .FALSE. ; lk_south = .FALSE. 953 ENDIF 954 955 ! Set ghost cells including over Parent grid: 956 nbghostcells_x_w = nbghostcells 957 nbghostcells_x_e = nbghostcells 871 958 nbghostcells_y_s = nbghostcells 872 959 nbghostcells_y_n = nbghostcells 873 ! 874 IF( l_Iperio ) nbghostcells_x = 0 875 IF( .NOT. lk_south ) nbghostcells_y_s = 0 876 IF( .NOT. lk_north ) nbghostcells_y_n = 0 877 ! 878 ! Some checks 879 IF( (.NOT.ln_vert_remap).AND.(jpkglo>Agrif_Parent(jpkglo)) ) CALL ctl_stop( 'STOP', & 880 & 'agrif_nemo_init: Agrif children must have less or equal number of vertical levels without ln_vert_remap defined' ) 881 IF( jpiglo /= nbcellsx + 2 + 2*nn_hls + nbghostcells_x + nbghostcells_x ) CALL ctl_stop( 'STOP', & 882 & 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nn_hls + 2*nbghostcells_x' ) 883 IF( jpjglo /= nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n ) CALL ctl_stop( 'STOP', & 884 & 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n' ) 885 IF( ln_use_jattr ) CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 960 961 IF (.NOT.lk_west ) nbghostcells_x_w = 1 962 IF (.NOT.lk_east ) nbghostcells_x_e = 1 963 IF (.NOT.lk_south) nbghostcells_y_s = 1 964 IF (.NOT.lk_north) nbghostcells_y_n = 1 965 966 IF ( l_Iperio ) THEN 967 nbghostcells_x_w = 0 ; nbghostcells_x_e = 0 968 ENDIF 969 IF ( l_NFold ) THEN 970 nbghostcells_y_n = 0 971 ENDIF 972 973 IF ( .NOT.Agrif_Root() ) THEN ! Check expected grid size: 974 IF( (.NOT.ln_vert_remap).AND.(jpkglo>Agrif_Parent(jpkglo)) ) CALL ctl_stop( 'STOP', & 975 & 'AGRIF children must have less or equal number of vertical levels without ln_vert_remap defined' ) 976 IF( Ni0glo /= nbcellsx + nbghostcells_x_w + nbghostcells_x_e ) CALL ctl_stop( 'STOP', & 977 & 'AGRIF children requires jpiglo == nbcellsx + nbghostcells_x_w + nbghostcells_x_e' ) 978 IF( Nj0glo /= nbcellsy + nbghostcells_y_s + nbghostcells_y_n ) CALL ctl_stop( 'STOP', & 979 & 'AGRIF children requires jpjglo == nbcellsy + nbghostcells_y_s + nbghostcells_y_n' ) 980 IF( ln_use_jattr ) CALL ctl_stop( 'STOP', 'AGRIF children requires ln_use_jattr = .false. ' ) 981 982 IF(lwp) THEN ! Control print 983 WRITE(numout,*) 984 WRITE(numout,*) 'AGRIF boundaries and ghost cells:' 985 WRITE(numout,*) 'lk_west' , lk_west 986 WRITE(numout,*) 'lk_east' , lk_east 987 WRITE(numout,*) 'lk_south', lk_south 988 WRITE(numout,*) 'lk_north', lk_north 989 WRITE(numout,*) 'nbghostcells_y_s', nbghostcells_y_s 990 WRITE(numout,*) 'nbghostcells_y_n', nbghostcells_y_n 991 WRITE(numout,*) 'nbghostcells_x_w', nbghostcells_x_w 992 WRITE(numout,*) 'nbghostcells_x_e', nbghostcells_x_e 993 ENDIF 994 ENDIF 995 996 9000 FORMAT (a, i4) 886 997 ! 887 998 ! … … 973 1084 ENDIF 974 1085 975 IF( bounds(2,2,2) > jpjglo) THEN1086 IF(( bounds(2,2,2) > jpjglo).AND. ( l_NFold )) THEN 976 1087 IF( bounds(2,1,2) <=jpjglo) THEN 977 1088 nb_chunks = 2 … … 1018 1129 1019 1130 IF( pty == 2) THEN ! T, U points 1020 bounds_chunks(2,2,1,2) = jpjglo-2 -(bounds(2,2,2) -jpjglo)1021 bounds_chunks(2,2,2,2) = jpjglo-2 -(jpjglo-2 -jpjglo)1131 bounds_chunks(2,2,1,2) = jpjglo-2*nn_hls-(bounds(2,2,2) -jpjglo) 1132 bounds_chunks(2,2,2,2) = jpjglo-2*nn_hls-(jpjglo-2 -jpjglo) 1022 1133 ELSE ! V, F points 1023 bounds_chunks(2,2,1,2) = jpjglo- 3-(bounds(2,2,2) -jpjglo)1024 bounds_chunks(2,2,2,2) = jpjglo- 3-(jpjglo-2 -jpjglo)1134 bounds_chunks(2,2,1,2) = jpjglo-2*nn_hls-1-(bounds(2,2,2) -jpjglo) 1135 bounds_chunks(2,2,2,2) = jpjglo-2*nn_hls-1-(jpjglo-2 -jpjglo) 1025 1136 ENDIF 1026 1137 ! Correction required or not … … 1043 1154 bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 1044 1155 1045 bounds_chunks(1,2,1,2) = jpjglo-2 -(bounds(2,2,2)-jpjglo)1046 bounds_chunks(1,2,2,2) = jpjglo-2 -(bounds(2,1,2)-jpjglo)1156 bounds_chunks(1,2,1,2) = jpjglo-2*nn_hls-(bounds(2,2,2)-jpjglo) 1157 bounds_chunks(1,2,2,2) = jpjglo-2*nn_hls-(bounds(2,1,2)-jpjglo) 1047 1158 1048 1159 IF( ptx == 2) THEN ! T, V points … … 1055 1166 1056 1167 IF (pty == 2) THEN ! T, U points 1057 bounds_chunks(1,2,1,2) = jpjglo-2 -(bounds(2,2,2) -jpjglo)1058 bounds_chunks(1,2,2,2) = jpjglo-2 -(bounds(2,1,2) -jpjglo)1168 bounds_chunks(1,2,1,2) = jpjglo-2*nn_hls-(bounds(2,2,2) -jpjglo) 1169 bounds_chunks(1,2,2,2) = jpjglo-2*nn_hls-(bounds(2,1,2) -jpjglo) 1059 1170 ELSE ! V, F points 1060 bounds_chunks(1,2,1,2) = jpjglo- 3-(bounds(2,2,2) -jpjglo)1061 bounds_chunks(1,2,2,2) = jpjglo- 3-(bounds(2,1,2) -jpjglo)1171 bounds_chunks(1,2,1,2) = jpjglo-2*nn_hls-1-(bounds(2,2,2) -jpjglo) 1172 bounds_chunks(1,2,2,2) = jpjglo-2*nn_hls-1-(bounds(2,1,2) -jpjglo) 1062 1173 ENDIF 1063 1174 … … 1065 1176 ENDIF 1066 1177 1067 ELSE IF ( bounds(1,1,2) < 1) THEN1178 ELSE IF ((bounds(1,1,2) < 1).AND.( l_Iperio )) THEN 1068 1179 IF (bounds(1,2,2) > 0) THEN 1069 1180 nb_chunks = 2 … … 1075 1186 END DO 1076 1187 1077 bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 1078 bounds_chunks(1,1,2,2) = 1+jpiglo-21188 bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2*nn_hls 1189 bounds_chunks(1,1,2,2) = jpiglo-nn_hls 1079 1190 1080 1191 bounds_chunks(1,1,1,1) = bounds(1,1,2) 1081 bounds_chunks(1,1,2,1) = 11192 bounds_chunks(1,1,2,1) = nn_hls+1 1082 1193 1083 bounds_chunks(2,1,1,2) = 21194 bounds_chunks(2,1,1,2) = nn_hls+1 1084 1195 bounds_chunks(2,1,2,2) = bounds(1,2,2) 1085 1196 1086 bounds_chunks(2,1,1,1) = 21197 bounds_chunks(2,1,1,1) = nn_hls+1 1087 1198 bounds_chunks(2,1,2,1) = bounds(1,2,2) 1088 1199 1089 1200 ELSE 1090 1201 nb_chunks = 1 … … 1095 1206 bounds_chunks(i,:,:,:) = bounds 1096 1207 END DO 1097 bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 1098 bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2 1208 bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2*nn_hls 1209 bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2*nn_hls 1099 1210 1100 1211 bounds_chunks(1,1,1,1) = bounds(1,1,2) 1101 bounds_chunks(1,1,2,1) = bounds(1,2,2)1212 bounds_chunks(1,1,2,1) = bounds(1,2,2) 1102 1213 ENDIF 1103 1214 ELSE … … 1136 1247 agrif_external_switch_index = jpiglo-i1+2 1137 1248 ELSE ! U, F points 1138 agrif_external_switch_index = jpiglo-i1+1 1249 agrif_external_switch_index = jpiglo-i1+1 1139 1250 ENDIF 1140 1251 ELSE IF( isens ==2 ) THEN 1141 1252 IF ( pty == 2 ) THEN ! T, U points 1142 agrif_external_switch_index = jpjglo-2 -(i1 -jpjglo)1253 agrif_external_switch_index = jpjglo-2*nn_hls-(i1 -jpjglo) 1143 1254 ELSE ! V, F points 1144 agrif_external_switch_index = jpjglo- 3-(i1 -jpjglo)1255 agrif_external_switch_index = jpjglo-2*nn_hls-1-(i1 -jpjglo) 1145 1256 ENDIF 1146 1257 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
