- Timestamp:
- 2017-12-13T15:58:53+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r7646 r9019 29 29 USE lib_mpp ! for mpp_sum 30 30 USE iom ! I/O 31 USE wrk_nemo ! Memory Allocation32 31 USE timing ! Timing 33 32 … … 117 116 ! 118 117 END SUBROUTINE bdy_init 119 118 119 120 120 SUBROUTINE bdy_segs 121 121 !!---------------------------------------------------------------------- … … 129 129 !! ** Input : bdy_init.nc, input file for unstructured open boundaries 130 130 !!---------------------------------------------------------------------- 131 132 ! local variables133 !-------------------134 131 INTEGER :: ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices 135 132 INTEGER :: icount, icountr, ibr_max, ilen1, ibm1 ! local integers … … 151 148 INTEGER :: com_east_b, com_west_b, com_south_b, com_north_b ! Flags for boundaries receiving 152 149 INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4) ! Arrays for neighbours coordinates 153 REAL(wp), POINTER, DIMENSION(:,:):: zfmask ! temporary fmask array excluding coastal boundary condition (shlat)150 REAL(wp), TARGET, DIMENSION(jpi,jpj) :: zfmask ! temporary fmask array excluding coastal boundary condition (shlat) 154 151 !! 155 152 CHARACTER(LEN=1) :: ctypebdy ! - - … … 351 348 IF(lwp) WRITE(numout,*) 352 349 353 #if defined key_lim 2354 IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice: '355 SELECT CASE( cn_ice_lim(ib_bdy) )356 350 #if defined key_lim3 351 IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice: ' 352 SELECT CASE( cn_ice_lim(ib_bdy) ) 353 CASE('none') 357 354 IF(lwp) WRITE(numout,*) ' no open boundary condition' 358 dta_bdy(ib_bdy)%ll_ frld= .false.359 dta_bdy(ib_bdy)%ll_h icif= .false.360 dta_bdy(ib_bdy)%ll_h snif= .false.361 355 dta_bdy(ib_bdy)%ll_a_i = .false. 356 dta_bdy(ib_bdy)%ll_h_i = .false. 357 dta_bdy(ib_bdy)%ll_h_s = .false. 358 CASE('frs') 362 359 IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 363 dta_bdy(ib_bdy)%ll_frld = .true. 364 dta_bdy(ib_bdy)%ll_hicif = .true. 365 dta_bdy(ib_bdy)%ll_hsnif = .true. 366 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for cn_ice_lim' ) 367 END SELECT 368 IF( cn_ice_lim(ib_bdy) /= 'none' ) THEN 369 SELECT CASE( nn_ice_lim_dta(ib_bdy) ) ! 370 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' initial state used for bdy data' 371 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' boundary data taken from file' 372 CASE DEFAULT ; CALL ctl_stop( 'nn_ice_lim_dta must be 0 or 1' ) 373 END SELECT 374 ENDIF 375 IF(lwp) WRITE(numout,*) 376 #elif defined key_lim3 377 IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice: ' 378 SELECT CASE( cn_ice_lim(ib_bdy) ) 379 CASE('none') 380 IF(lwp) WRITE(numout,*) ' no open boundary condition' 381 dta_bdy(ib_bdy)%ll_a_i = .false. 382 dta_bdy(ib_bdy)%ll_ht_i = .false. 383 dta_bdy(ib_bdy)%ll_ht_s = .false. 384 CASE('frs') 385 IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 386 dta_bdy(ib_bdy)%ll_a_i = .true. 387 dta_bdy(ib_bdy)%ll_ht_i = .true. 388 dta_bdy(ib_bdy)%ll_ht_s = .true. 389 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for cn_ice_lim' ) 390 END SELECT 360 dta_bdy(ib_bdy)%ll_a_i = .true. 361 dta_bdy(ib_bdy)%ll_h_i = .true. 362 dta_bdy(ib_bdy)%ll_h_s = .true. 363 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for cn_ice_lim' ) 364 END SELECT 391 365 IF( cn_ice_lim(ib_bdy) /= 'none' ) THEN 392 366 SELECT CASE( nn_ice_lim_dta(ib_bdy) ) ! … … 404 378 IF(lwp) WRITE(numout,*) ' Width of relaxation zone = ', nn_rimwidth(ib_bdy) 405 379 IF(lwp) WRITE(numout,*) 406 407 END DO408 409 IF (nb_bdy .gt. 0) THEN380 ! 381 END DO 382 383 IF( nb_bdy > 0 ) THEN 410 384 IF( ln_vol ) THEN ! check volume conservation (nn_volctl value) 411 385 IF(lwp) WRITE(numout,*) 'Volume correction applied at open boundaries' … … 528 502 DO igrd = 1, jpbgrd 529 503 id_dummy = iom_varid( inum, 'nbi'//cgrid(igrd), kdimsz=kdimsz ) 530 !clem nblendta(igrd,ib_bdy) = kdimsz(1)531 !clem jpbdtau = MAX(jpbdtau, kdimsz(1))532 504 nblendta(igrd,ib_bdy) = MAXVAL(kdimsz) 533 505 jpbdtau = MAX(jpbdtau, MAXVAL(kdimsz)) … … 919 891 IF( nbrdta(ib,igrd,ib_bdy) == 1 ) icountr = icountr+1 920 892 ENDIF 921 END DO893 END DO 922 894 idx_bdy(ib_bdy)%nblenrim(igrd) = icountr !: length of rim boundary data on each proc 923 895 idx_bdy(ib_bdy)%nblen (igrd) = icount !: length of boundary data on each proc 924 END DO ! igrd896 END DO ! igrd 925 897 926 898 ! Allocate index arrays for this boundary set 927 899 !-------------------------------------------- 928 900 ilen1 = MAXVAL( idx_bdy(ib_bdy)%nblen(:) ) 929 ALLOCATE( idx_bdy(ib_bdy)%nbi (ilen1,jpbgrd) )930 ALLOCATE( idx_bdy(ib_bdy)%nbj (ilen1,jpbgrd) )931 ALLOCATE( idx_bdy(ib_bdy)%nbr (ilen1,jpbgrd) )932 ALLOCATE( idx_bdy(ib_bdy)%nbd (ilen1,jpbgrd) )933 ALLOCATE( idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) )934 ALLOCATE( idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) )935 ALLOCATE( idx_bdy(ib_bdy)%nbw (ilen1,jpbgrd) )936 ALLOCATE( idx_bdy(ib_bdy)%flagu (ilen1,jpbgrd) )937 ALLOCATE(idx_bdy(ib_bdy)%flagv (ilen1,jpbgrd) )901 ALLOCATE( idx_bdy(ib_bdy)%nbi (ilen1,jpbgrd) , & 902 & idx_bdy(ib_bdy)%nbj (ilen1,jpbgrd) , & 903 & idx_bdy(ib_bdy)%nbr (ilen1,jpbgrd) , & 904 & idx_bdy(ib_bdy)%nbd (ilen1,jpbgrd) , & 905 & idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) , & 906 & idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) , & 907 & idx_bdy(ib_bdy)%nbw (ilen1,jpbgrd) , & 908 & idx_bdy(ib_bdy)%flagu (ilen1,jpbgrd) , & 909 & idx_bdy(ib_bdy)%flagv (ilen1,jpbgrd) ) 938 910 939 911 ! Dispatch mapping indices and discrete distances on each processor … … 1148 1120 END DO 1149 1121 1150 END DO1122 END DO 1151 1123 1152 1124 ! ------------------------------------------------------ … … 1212 1184 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1213 1185 bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 1214 END DO1215 END DO1186 END DO 1187 END DO 1216 1188 1217 1189 ! For the flagu/flagv calculation below we require a version of fmask without 1218 1190 ! the land boundary condition (shlat) included: 1219 CALL wrk_alloc(jpi,jpj, zfmask )1220 1191 DO ij = 2, jpjm1 1221 1192 DO ii = 2, jpim1 … … 1241 1212 ! flagu = 1 : u is normal to the boundary and is direction is inward 1242 1213 1243 DO igrd = 1, jpbgrd1214 DO igrd = 1, jpbgrd 1244 1215 SELECT CASE( igrd ) 1245 1216 CASE( 1 ) ; pmask => umask (:,:,1) ; i_offset = 0 … … 1346 1317 IF( nb_bdy>0 ) DEALLOCATE( nbidta, nbjdta, nbrdta ) 1347 1318 ! 1348 CALL wrk_dealloc(jpi,jpj, zfmask )1349 !1350 1319 IF( nn_timing == 1 ) CALL timing_stop('bdy_segs') 1351 1320 ! 1352 1321 END SUBROUTINE bdy_segs 1322 1353 1323 1354 1324 SUBROUTINE bdy_ctl_seg … … 1727 1697 END SUBROUTINE bdy_ctl_seg 1728 1698 1699 1729 1700 SUBROUTINE bdy_ctl_corn( ib1, ib2 ) 1730 1701 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.