- Timestamp:
- 2019-12-10T12:57:49+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/BDY/bdytra.F90
r10529 r12143 49 49 INTEGER, INTENT(in) :: kt ! Main time step counter 50 50 ! 51 INTEGER :: ib_bdy, jn, igrd ! Loop indeces 52 TYPE(ztrabdy), DIMENSION(jpts) :: zdta ! Temporary data structure 51 INTEGER :: ib_bdy, jn, igrd, ir ! Loop indeces 52 TYPE(ztrabdy), DIMENSION(jpts) :: zdta ! Temporary data structure 53 LOGICAL :: llrim0 ! indicate if rim 0 is treated 54 LOGICAL, DIMENSION(4) :: llsend1, llrecv1 ! indicate how communications are to be carried out 53 55 !!---------------------------------------------------------------------- 54 56 igrd = 1 55 56 DO ib_bdy=1, nb_bdy 57 llsend1(:) = .false. ; llrecv1(:) = .false. 58 DO ir = 1, 0, -1 ! treat rim 1 before rim 0 59 IF( ir == 0 ) THEN ; llrim0 = .TRUE. 60 ELSE ; llrim0 = .FALSE. 61 END IF 62 DO ib_bdy=1, nb_bdy 63 ! 64 zdta(1)%tra => dta_bdy(ib_bdy)%tem 65 zdta(2)%tra => dta_bdy(ib_bdy)%sal 66 ! 67 DO jn = 1, jpts 68 ! 69 SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 70 CASE('none' ) ; CYCLE 71 CASE('frs' ) ! treat the whole boundary at once 72 IF( ir == 0 ) CALL bdy_frs ( idx_bdy(ib_bdy), tsa(:,:,:,jn), zdta(jn)%tra ) 73 CASE('specified' ) ! treat the whole rim at once 74 IF( ir == 0 ) CALL bdy_spe ( idx_bdy(ib_bdy), tsa(:,:,:,jn), zdta(jn)%tra ) 75 CASE('neumann' ) ; CALL bdy_nmn ( idx_bdy(ib_bdy), igrd , tsa(:,:,:,jn), llrim0 ) ! tsa masked 76 CASE('orlanski' ) ; CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), & 77 & zdta(jn)%tra, llrim0, ll_npo=.false. ) 78 CASE('orlanski_npo') ; CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), & 79 & zdta(jn)%tra, llrim0, ll_npo=.true. ) 80 CASE('runoff' ) ; CALL bdy_rnf ( idx_bdy(ib_bdy), tsa(:,:,:,jn), jn, llrim0 ) 81 CASE DEFAULT ; CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 82 END SELECT 83 ! 84 END DO 85 END DO 57 86 ! 58 zdta(1)%tra => dta_bdy(ib_bdy)%tem 59 zdta(2)%tra => dta_bdy(ib_bdy)%sal 87 IF( nn_hls > 1 .AND. ir == 1 ) CYCLE ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 88 IF( nn_hls == 1 ) THEN ; llsend1(:) = .false. ; llrecv1(:) = .false. ; END IF 89 DO ib_bdy=1, nb_bdy 90 SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 91 CASE('neumann','runoff') 92 llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:,ir) ! possibly every direction, T points 93 llrecv1(:) = llrecv1(:) .OR. lrecv_bdyint(ib_bdy,1,:,ir) ! possibly every direction, T points 94 CASE('orlanski', 'orlanski_npo') 95 llsend1(:) = llsend1(:) .OR. lsend_bdy(ib_bdy,1,:,ir) ! possibly every direction, T points 96 llrecv1(:) = llrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:,ir) ! possibly every direction, T points 97 END SELECT 98 END DO 99 IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN ! if need to send/recv in at least one direction 100 CALL lbc_lnk( 'bdytra', tsa, 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 101 END IF 60 102 ! 61 DO jn = 1, jpts 62 ! 63 SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 64 CASE('none' ) ; CYCLE 65 CASE('frs' ) ; CALL bdy_frs ( idx_bdy(ib_bdy), tsa(:,:,:,jn), zdta(jn)%tra ) 66 CASE('specified' ) ; CALL bdy_spe ( idx_bdy(ib_bdy), tsa(:,:,:,jn), zdta(jn)%tra ) 67 CASE('neumann' ) ; CALL bdy_nmn ( idx_bdy(ib_bdy), igrd , tsa(:,:,:,jn) ) 68 CASE('orlanski' ) ; CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.false. ) 69 CASE('orlanski_npo') ; CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.true. ) 70 CASE('runoff' ) ; CALL bdy_rnf ( idx_bdy(ib_bdy), tsa(:,:,:,jn), jn ) 71 CASE DEFAULT ; CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 72 END SELECT 73 ! Boundary points should be updated 74 CALL lbc_bdy_lnk( 'bdytra', tsa(:,:,:,jn), 'T', 1., ib_bdy ) 75 ! 76 END DO 77 END DO 103 END DO ! ir 78 104 ! 79 105 END SUBROUTINE bdy_tra 80 106 81 107 82 SUBROUTINE bdy_rnf( idx, pta, jpa )108 SUBROUTINE bdy_rnf( idx, pta, jpa, llrim0 ) 83 109 !!---------------------------------------------------------------------- 84 110 !! *** SUBROUTINE bdy_rnf *** … … 89 115 !! 90 116 !!---------------------------------------------------------------------- 91 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 92 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pta ! tracer trend 93 INTEGER, INTENT(in) :: jpa ! TRA index 117 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 118 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pta ! tracer trend 119 INTEGER, INTENT(in) :: jpa ! TRA index 120 LOGICAL, INTENT(in) :: llrim0 ! indicate if rim 0 is treated 94 121 ! 95 REAL(wp) :: zwgt ! boundary weight 96 INTEGER :: ib, ik, igrd ! dummy loop indices 97 INTEGER :: ii, ij, ip, jp ! 2D addresses 122 INTEGER :: ib, ii, ij, igrd ! dummy loop indices 123 INTEGER :: ik, ip, jp ! 2D addresses 98 124 !!---------------------------------------------------------------------- 99 125 ! 100 126 igrd = 1 ! Everything is at T-points here 101 DO ib = 1, idx%nblenrim(igrd)102 ii = idx%nbi(ib,igrd)103 ij = idx%nbj(ib,igrd)104 DO ik = 1, jpkm1105 ip = bdytmask(ii+1,ij ) - bdytmask(ii-1,ij )106 jp = bdytmask(ii ,ij+1) - bdytmask(ii ,ij-1)107 i f (jpa == jp_tem) pta(ii,ij,ik) = pta(ii+ip,ij+jp,ik) * tmask(ii,ij,ik)108 if (jpa == jp_sal) pta(ii,ij,ik) = 0.1 * tmask(ii,ij,ik)127 IF( jpa == jp_tem ) THEN 128 CALL bdy_nmn( idx, igrd, pta, llrim0 ) 129 ELSE IF( jpa == jp_sal ) THEN 130 IF( .NOT. llrim0 ) RETURN 131 DO ib = 1, idx%nblenrim(igrd) ! if llrim0 then treat the whole rim 132 ii = idx%nbi(ib,igrd) 133 ij = idx%nbj(ib,igrd) 134 pta(ii,ij,1:jpkm1) = 0.1 * tmask(ii,ij,1:jpkm1) 109 135 END DO 110 END DO136 END IF 111 137 ! 112 138 END SUBROUTINE bdy_rnf
Note: See TracChangeset
for help on using the changeset viewer.
