- Timestamp:
- 2016-12-01T11:30:29+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r6140 r7412 13 13 !! 3.4 ! 2012 (J. Chanut) straight open boundary case update 14 14 !! 3.5 ! 2012 (S. Mocavero, I. Epicoco) optimization of BDY communications 15 !!---------------------------------------------------------------------- 16 #if defined key_bdy 17 !!---------------------------------------------------------------------- 18 !! 'key_bdy' Unstructured Open Boundary Conditions 15 !! 3.7 ! 2016 (T. Lovato) Remove bdy macro, call here init for dta and tides 19 16 !!---------------------------------------------------------------------- 20 17 !! bdy_init : Initialization of unstructured open boundaries … … 23 20 USE dom_oce ! ocean space and time domain 24 21 USE bdy_oce ! unstructured open boundary conditions 25 USE sbctide , ONLY: lk_tide ! Tidal forcing or not 22 USE bdydta ! open boundary cond. setting (bdy_dta_init routine) 23 USE bdytides ! open boundary cond. setting (bdytide_init routine) 24 USE sbctide ! Tidal forcing or not 26 25 USE phycst , ONLY: rday 27 26 ! … … 53 52 !!---------------------------------------------------------------------- 54 53 CONTAINS 55 54 56 55 SUBROUTINE bdy_init 57 56 !!---------------------------------------------------------------------- 58 57 !! *** ROUTINE bdy_init *** 58 !! 59 !! ** Purpose : Initialization of the dynamics and tracer fields with 60 !! unstructured open boundaries. 61 !! 62 !! ** Method : Read initialization arrays (mask, indices) to identify 63 !! an unstructured open boundary 64 !! 65 !! ** Input : bdy_init.nc, input file for unstructured open boundaries 66 !!---------------------------------------------------------------------- 67 NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file, & 68 & ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta, & 69 & cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta, & 70 & ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 71 & cn_ice_lim, nn_ice_lim_dta, & 72 & rn_ice_tem, rn_ice_sal, rn_ice_age, & 73 & ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy 74 ! 75 INTEGER :: ios ! Local integer output status for namelist read 76 !!---------------------------------------------------------------------- 77 ! 78 IF( nn_timing == 1 ) CALL timing_start('bdy_init') 79 80 ! ------------------------ 81 ! Read namelist parameters 82 ! ------------------------ 83 REWIND( numnam_ref ) ! Namelist nambdy in reference namelist :Unstructured open boundaries 84 READ ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901) 85 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 86 ! 87 REWIND( numnam_cfg ) ! Namelist nambdy in configuration namelist :Unstructured open boundaries 88 READ ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 ) 89 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 90 IF(lwm) WRITE ( numond, nambdy ) 91 92 ! ----------------------------------------- 93 ! unstructured open boundaries use control 94 ! ----------------------------------------- 95 IF ( ln_bdy ) THEN 96 IF(lwp) WRITE(numout,*) 97 IF(lwp) WRITE(numout,*) 'bdy_init : initialization of open boundaries' 98 IF(lwp) WRITE(numout,*) '~~~~~~~~' 99 ! 100 ! Open boundaries definition (arrays and masks) 101 CALL bdy_segs 102 ! 103 ! Open boundaries initialisation of external data arrays 104 CALL bdy_dta_init 105 ! 106 ! Open boundaries initialisation of tidal harmonic forcing 107 IF( ln_tide ) CALL bdytide_init 108 ! 109 ELSE 110 IF(lwp) WRITE(numout,*) 111 IF(lwp) WRITE(numout,*) 'bdy_init : open boundaries not used (ln_bdy = F)' 112 IF(lwp) WRITE(numout,*) '~~~~~~~~' 113 ! 114 ENDIF 115 ! 116 IF( nn_timing == 1 ) CALL timing_stop('bdy_init') 117 ! 118 END SUBROUTINE bdy_init 119 120 SUBROUTINE bdy_segs 121 !!---------------------------------------------------------------------- 122 !! *** ROUTINE bdy_init *** 59 123 !! 60 !! ** Purpose : Initialization of the dynamics and tracer fields with 61 !! unstructured open boundaries. 124 !! ** Purpose : Definition of unstructured open boundaries. 62 125 !! 63 126 !! ** Method : Read initialization arrays (mask, indices) to identify … … 90 153 REAL(wp), POINTER, DIMENSION(:,:) :: zfmask ! temporary fmask array excluding coastal boundary condition (shlat) 91 154 !! 92 CHARACTER(LEN=80),DIMENSION(jpbgrd) :: clfile ! Namelist variables93 155 CHARACTER(LEN=1) :: ctypebdy ! - - 94 156 INTEGER :: nbdyind, nbdybeg, nbdyend 95 157 !! 96 NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file, &97 & ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta, &98 & cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta, &99 & ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &100 & cn_ice_lim, nn_ice_lim_dta, &101 & rn_ice_tem, rn_ice_sal, rn_ice_age, &102 & ln_vol, nn_volctl, nn_rimwidth103 !104 158 NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend 105 159 INTEGER :: ios ! Local integer output status for namelist read 106 160 !!---------------------------------------------------------------------- 107 161 ! 108 IF( nn_timing == 1 ) CALL timing_start('bdy_init') 109 ! 110 IF(lwp) WRITE(numout,*) 111 IF(lwp) WRITE(numout,*) 'bdy_init : initialization of open boundaries' 112 IF(lwp) WRITE(numout,*) '~~~~~~~~' 113 ! 114 IF( jperio /= 0 ) CALL ctl_stop( 'Cyclic or symmetric,', & 115 & ' and general open boundary condition are not compatible' ) 116 162 IF( nn_timing == 1 ) CALL timing_start('bdy_segs') 163 ! 117 164 cgrid = (/'t','u','v'/) 118 119 ! ------------------------120 ! Read namelist parameters121 ! ------------------------122 REWIND( numnam_ref ) ! Namelist nambdy in reference namelist :Unstructured open boundaries123 READ ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901)124 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp )125 !126 REWIND( numnam_cfg ) ! Namelist nambdy in configuration namelist :Unstructured open boundaries127 READ ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 )128 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp )129 IF(lwm) WRITE ( numond, nambdy )130 165 131 166 ! ----------------------------------------- 132 167 ! Check and write out namelist parameters 133 168 ! ----------------------------------------- 134 ! ! control prints135 IF(lwp) WRITE(numout,*) ' nambdy'169 IF( jperio /= 0 ) CALL ctl_stop( 'bdy_segs: Cyclic or symmetric,', & 170 & ' and general open boundary condition are not compatible' ) 136 171 137 172 IF( nb_bdy == 0 ) THEN … … 189 224 CASE DEFAULT ; CALL ctl_stop( 'nn_dyn2d_dta must be between 0 and 3' ) 190 225 END SELECT 191 IF (( nn_dyn2d_dta(ib_bdy) .ge. 2 ).AND.(.NOT.l k_tide)) THEN192 CALL ctl_stop( 'You must activate key_tide to add tidal forcing at open boundaries' )226 IF (( nn_dyn2d_dta(ib_bdy) .ge. 2 ).AND.(.NOT.ln_tide)) THEN 227 CALL ctl_stop( 'You must activate with ln_tide to add tidal forcing at open boundaries' ) 193 228 ENDIF 194 229 ENDIF … … 209 244 dta_bdy(ib_bdy)%ll_u3d = .true. 210 245 dta_bdy(ib_bdy)%ll_v3d = .true. 246 CASE('neumann') 247 IF(lwp) WRITE(numout,*) ' Neumann conditions' 248 dta_bdy(ib_bdy)%ll_u3d = .false. 249 dta_bdy(ib_bdy)%ll_v3d = .false. 250 CASE('zerograd') 251 IF(lwp) WRITE(numout,*) ' Zero gradient for baroclinic velocities' 252 dta_bdy(ib_bdy)%ll_u3d = .false. 253 dta_bdy(ib_bdy)%ll_v3d = .false. 211 254 CASE('zero') 212 255 IF(lwp) WRITE(numout,*) ' Zero baroclinic velocities (runoff case)' … … 377 420 IF(lwp) WRITE(numout,*) 'No volume correction applied at open boundaries' 378 421 IF(lwp) WRITE(numout,*) 422 ENDIF 423 IF( nb_jpk_bdy > 0 ) THEN 424 IF(lwp) WRITE(numout,*) '*** open boundary will be interpolate in the vertical onto the native grid ***' 425 ELSE 426 IF(lwp) WRITE(numout,*) '*** open boundary will be read straight onto the native grid without vertical interpolation ***' 379 427 ENDIF 380 428 ENDIF … … 499 547 & nbrdta(jpbdta, jpbgrd, nb_bdy) ) 500 548 501 ALLOCATE( dta_global(jpbdtau, 1, jpk) ) 502 IF ( icount>0 ) ALLOCATE( dta_global2(jpbdtas, nrimmax, jpk) ) 549 IF( nb_jpk_bdy>0 ) THEN 550 ALLOCATE( dta_global(jpbdtau, 1, nb_jpk_bdy) ) 551 ALLOCATE( dta_global_z(jpbdtau, 1, nb_jpk_bdy) ) 552 ALLOCATE( dta_global_dz(jpbdtau, 1, nb_jpk_bdy) ) 553 ELSE 554 ALLOCATE( dta_global(jpbdtau, 1, jpk) ) 555 ALLOCATE( dta_global_z(jpbdtau, 1, jpk) ) ! needed ?? TODO 556 ALLOCATE( dta_global_dz(jpbdtau, 1, jpk) )! needed ?? TODO 557 ENDIF 558 559 IF ( icount>0 ) THEN 560 IF( nb_jpk_bdy>0 ) THEN 561 ALLOCATE( dta_global2(jpbdtas, nrimmax, nb_jpk_bdy) ) 562 ALLOCATE( dta_global2_z(jpbdtas, nrimmax, nb_jpk_bdy) ) 563 ALLOCATE( dta_global2_dz(jpbdtas, nrimmax, nb_jpk_bdy) ) 564 ELSE 565 ALLOCATE( dta_global2(jpbdtas, nrimmax, jpk) ) 566 ALLOCATE( dta_global2_z(jpbdtas, nrimmax, jpk) ) ! needed ?? TODO 567 ALLOCATE( dta_global2_dz(jpbdtas, nrimmax, jpk) )! needed ?? TODO 568 ENDIF 569 ENDIF 503 570 ! 504 571 ENDIF … … 839 906 IF(lwp) THEN ! Since all procs read global data only need to do this check on one proc... 840 907 IF( nbrdta(ib,igrd,ib_bdy) < nbrdta(ibm1,igrd,ib_bdy) ) THEN 841 CALL ctl_stop('bdy_ init: ERROR : boundary data in file must be defined ', &908 CALL ctl_stop('bdy_segs : ERROR : boundary data in file must be defined ', & 842 909 & ' in order of distance from edge nbr A utility for re-ordering ', & 843 910 & ' boundary coordinates and data files exists in the TOOLS/OBC directory') … … 1092 1159 ! = 0 elsewhere 1093 1160 1161 bdytmask(:,:) = ssmask(:,:) 1162 1094 1163 IF( ln_mask_file ) THEN 1095 1164 CALL iom_open( cn_mask_file, inum ) … … 1108 1177 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) ; CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) ! Lateral boundary cond. 1109 1178 1110 1111 ! Mask corrections1112 ! ----------------1113 DO ik = 1, jpkm11114 DO ij = 1, jpj1115 DO ii = 1, jpi1116 tmask(ii,ij,ik) = tmask(ii,ij,ik) * bdytmask(ii,ij)1117 umask(ii,ij,ik) = umask(ii,ij,ik) * bdyumask(ii,ij)1118 vmask(ii,ij,ik) = vmask(ii,ij,ik) * bdyvmask(ii,ij)1119 END DO1120 END DO1121 DO ij = 2, jpjm11122 DO ii = 2, jpim11123 fmask(ii,ij,ik) = fmask(ii,ij,ik) * bdytmask(ii,ij ) * bdytmask(ii+1,ij ) &1124 & * bdytmask(ii,ij+1) * bdytmask(ii+1,ij+1)1125 END DO1126 END DO1127 END DO1128 tmask_i (:,:) = ssmask(:,:) * tmask_i(:,:)1129 !1130 1179 ENDIF ! ln_mask_file=.TRUE. 1131 1180 1132 bdytmask(:,:) = ssmask(:,:)1133 1181 IF( .NOT.ln_mask_file ) THEN 1134 1182 ! If .not. ln_mask_file then we need to derive mask on U and V grid from mask on T grid here. … … 1300 1348 CALL wrk_dealloc(jpi,jpj, zfmask ) 1301 1349 ! 1302 IF( nn_timing == 1 ) CALL timing_stop('bdy_init') 1303 ! 1304 END SUBROUTINE bdy_init 1305 1350 IF( nn_timing == 1 ) CALL timing_stop('bdy_segs') 1351 ! 1352 END SUBROUTINE bdy_segs 1306 1353 1307 1354 SUBROUTINE bdy_ctl_seg … … 1713 1760 END SUBROUTINE bdy_ctl_corn 1714 1761 1715 #else1716 !!---------------------------------------------------------------------------------1717 !! Dummy module NO open boundaries1718 !!---------------------------------------------------------------------------------1719 CONTAINS1720 SUBROUTINE bdy_init ! Dummy routine1721 END SUBROUTINE bdy_init1722 #endif1723 1724 1762 !!================================================================================= 1725 1763 END MODULE bdyini
Note: See TracChangeset
for help on using the changeset viewer.