- Timestamp:
- 2021-06-17T19:17:25+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/ticket2680_C1D_PAPA
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/NST/agrif_user.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/ticket2680_C1D_PAPA
- 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/ticket2680_C1D_PAPA/src/NST/agrif_user.F90
r14433 r15015 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 … … 78 79 ! 1. Declaration of the type of variable which have to be interpolated 79 80 !--------------------------------------------------------------------- 80 ind1 = nbghostcells 81 ind2 = nn_hls + 2 + nbghostcells_x 82 ind3 = nn_hls + 2 + nbghostcells_y_s 81 ! ind1 = nbghostcells 82 ind2 = nn_hls + 1 + nbghostcells_x 83 ind3 = nn_hls + 1 + nbghostcells_y_s 84 nbghostcellsfine_tot_x = nbghostcells_x+1 85 nbghostcellsfine_tot_y = MAX(nbghostcells_y_s,nbghostcells_y_n)+1 86 ind1 = MAX(nbghostcellsfine_tot_x, nbghostcellsfine_tot_y) 83 87 imaxrho = MAX(Agrif_irhox(), Agrif_irhoy()) 84 88 … … 120 124 ! 3. Location of interpolation 121 125 !----------------------------- 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/) ) 126 CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) ) 125 127 126 128 ! extend the interpolation zone by 1 more point than necessary: 127 129 ! 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/) ) 130 CALL Agrif_Set_bc( e3t0_interp_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) ) 131 CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) ) 132 CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) ) 133 131 134 CALL Agrif_Set_bc( tsini_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4 132 135 CALL Agrif_Set_bc( uini_id, (/0,ind1-1/) ) … … 142 145 #endif 143 146 144 !CALL Agrif_Set_ExternalMapping(nemo_mapping)147 CALL Agrif_Set_ExternalMapping(nemo_mapping) 145 148 ! 146 149 END SUBROUTINE agrif_declare_var_ini … … 222 225 ! 223 226 ! 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') 227 jpk_parent = Agrif_parent( jpk ) 228 ALLOCATE(e3t0_parent(jpi,jpj,jpk_parent), & 229 & e3u0_parent(jpi,jpj,jpk_parent), & 230 & e3v0_parent(jpi,jpj,jpk_parent), STAT = ierr) 231 IF( ierr > 0 ) CALL ctl_warn('Agrif_Init_Domain: allocation of arrays failed') 231 232 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 233 ! Retrieve expected parent scale factors on child grid: 234 Agrif_UseSpecialValue = .FALSE. 235 e3t0_parent(:,:,:) = 0._wp 236 CALL Agrif_Init_Variable(e3t0_interp_id, procname=interpe3t0_vremap) 237 ! 238 ! Deduce scale factors at U and V points: 239 DO_3D( 0, 0, 0, 0, 1, jpk_parent ) 240 e3u0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji+1,jj ,jk)) 241 e3v0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji ,jj+1,jk)) 242 END_3D 243 244 ! Assume a step at the bottom except if (pure) s-coordinates 245 IF ( .NOT.Agrif_Parent(ln_sco) ) THEN 246 DO_2D( 1, 0, 1, 0 ) 247 jk = mbku_parent(ji,jj) 248 e3u0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji+1,jj ,jk)) 249 jk = mbkv_parent(ji,jj) 250 e3v0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji ,jj+1,jk)) 251 END_2D 252 ENDIF 253 254 CALL lbc_lnk( 'Agrif_Init_Domain', e3u0_parent, 'U', 1.0_wp, e3v0_parent, 'V', 1.0_wp ) 255 255 256 256 ! check if masks and bathymetries match … … 262 262 ! 263 263 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 264 ! 265 CALL Agrif_check_bat( kindic_agr ) 275 266 ! 276 267 CALL mpp_sum( 'agrif_InitValues_Domain', kindic_agr ) … … 287 278 WHERE (ssmask(:,:) == 0._wp) mbkt_parent(:,:) = 0 288 279 ! 280 IF ( .NOT.ln_vert_remap ) DEALLOCATE(e3t0_parent, e3u0_parent, e3v0_parent) 281 289 282 END SUBROUTINE Agrif_Init_Domain 290 283 … … 440 433 !--------------------------------------------------------------------- 441 434 ind1 = nbghostcells 442 ind2 = nn_hls + 2+ nbghostcells_x443 ind3 = nn_hls + 2+ nbghostcells_y_s435 ind2 = nn_hls + 1 + nbghostcells_x 436 ind3 = nn_hls + 1 + nbghostcells_y_s 444 437 imaxrho = MAX(Agrif_irhox(), Agrif_irhoy()) 445 438 … … 640 633 !------------------------------------------------------------------------------------- 641 634 ind1 = nbghostcells 642 ind2 = nn_hls + 2+ nbghostcells_x643 ind3 = nn_hls + 2+ nbghostcells_y_s635 ind2 = nn_hls + 1 + nbghostcells_x 636 ind3 = nn_hls + 1 + nbghostcells_y_s 644 637 ipl = jpl*(9+nlay_s+nlay_i) 645 638 CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_ice_id) … … 780 773 !--------------------------------------------------------------------- 781 774 ind1 = nbghostcells 782 ind2 = nn_hls + 2+ nbghostcells_x783 ind3 = nn_hls + 2+ nbghostcells_y_s775 ind2 = nn_hls + 1 + nbghostcells_x 776 ind3 = nn_hls + 1 + nbghostcells_y_s 784 777 imaxrho = MAX(Agrif_irhox(), Agrif_irhoy()) 785 778 … … 862 855 863 856 ! 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 871 nbghostcells_y_s = nbghostcells 872 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. ' ) 857 IF (.not.agrif_root()) THEN 858 nbghostcells_x = nbghostcells 859 nbghostcells_y_s = nbghostcells 860 nbghostcells_y_n = nbghostcells 861 862 863 lk_west = .TRUE. 864 lk_east = .TRUE. 865 lk_south = .TRUE. 866 lk_north = .TRUE. 867 ! 868 ! Correct number of ghost cells according to periodicity 869 ! 870 IF( l_Iperio ) THEN ; lk_west = .FALSE. ; lk_east = .FALSE. ; nbghostcells_x = 0 ; ENDIF 871 IF( Agrif_Iy() == 1 ) THEN ; lk_south = .FALSE. ; nbghostcells_y_s = 1 ; ENDIF 872 IF( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(Nj0glo) - 1 ) THEN ; lk_north = .FALSE. ; nbghostcells_y_n = 1 ; ENDIF 873 ! 874 ! Some checks 875 IF( (.NOT.ln_vert_remap).AND.(jpkglo>Agrif_Parent(jpkglo)) ) CALL ctl_stop( 'STOP', & 876 & 'agrif_nemo_init: Agrif children must have less or equal number of vertical levels without ln_vert_remap defined' ) 877 IF( Ni0glo /= nbcellsx + nbghostcells_x + nbghostcells_x ) CALL ctl_stop( 'STOP', & 878 & 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2*nbghostcells_x' ) 879 IF( Nj0glo /= nbcellsy + nbghostcells_y_s + nbghostcells_y_n ) CALL ctl_stop( 'STOP', & 880 & 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + nbghostcells_y_s + nbghostcells_y_n' ) 881 IF( ln_use_jattr ) CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 882 ELSE 883 ! Root grid 884 nbghostcells_x = 1 885 nbghostcells_y_s = 1 886 nbghostcells_y_n = 1 887 IF ( l_Iperio.OR.l_NFold ) THEN 888 nbghostcells_x = 0 889 ENDIF 890 IF ( l_NFold ) THEN 891 nbghostcells_y_n = 0 ! for completeness 892 ENDIF 893 ENDIF 886 894 ! 887 895 ! … … 973 981 ENDIF 974 982 975 IF( bounds(2,2,2) > jpjglo) THEN983 IF(( bounds(2,2,2) > jpjglo).AND. ( l_NFold )) THEN 976 984 IF( bounds(2,1,2) <=jpjglo) THEN 977 985 nb_chunks = 2 … … 1065 1073 ENDIF 1066 1074 1067 ELSE IF ( bounds(1,1,2) < 1) THEN1075 ELSE IF ((bounds(1,1,2) < 1).AND.( l_Iperio )) THEN 1068 1076 IF (bounds(1,2,2) > 0) THEN 1069 1077 nb_chunks = 2
Note: See TracChangeset
for help on using the changeset viewer.
