Changeset 11191 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdytra.F90
- Timestamp:
- 2019-06-27T10:14:39+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdytra.F90
r11071 r11191 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 53 LOGICAL, DIMENSION(4) :: llsend1, llrecv1 ! indicate how communications are to be carried out 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 54 55 !!---------------------------------------------------------------------- 55 56 igrd = 1 56 57 57 DO ib_bdy=1, nb_bdy 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 58 86 ! 59 zdta(1)%tra => dta_bdy(ib_bdy)%tem 60 zdta(2)%tra => dta_bdy(ib_bdy)%sal 61 ! 62 DO jn = 1, jpts 63 ! 87 llsend1(:) = .false. 88 llrecv1(:) = .false. 89 DO ib_bdy=1, nb_bdy 64 90 SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 65 CASE('none' ) ; CYCLE 66 CASE('frs' ) ; CALL bdy_frs ( idx_bdy(ib_bdy), tsa(:,:,:,jn), zdta(jn)%tra ) 67 CASE('specified' ) ; CALL bdy_spe ( idx_bdy(ib_bdy), tsa(:,:,:,jn), zdta(jn)%tra ) 68 CASE('neumann' ) ; CALL bdy_nmn ( idx_bdy(ib_bdy), igrd , tsa(:,:,:,jn) ) ! tsa masked 69 CASE('orlanski' ) ; CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.false. ) 70 CASE('orlanski_npo') ; CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.true. ) 71 CASE('runoff' ) ; CALL bdy_rnf ( idx_bdy(ib_bdy), tsa(:,:,:,jn), jn ) 72 CASE DEFAULT ; CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 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 73 97 END SELECT 74 !75 98 END DO 99 IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN ! if need to send/recv in at least one direction 100 CALL lbc_bdy_lnk( 'bdytra', llsend1, llrecv1, tsa, 'T', 1. ) 101 END IF 76 102 END DO 77 !78 llsend1(:) = .false.79 llrecv1(:) = .false.80 DO ib_bdy=1, nb_bdy81 SELECT CASE( TRIM(cn_tra(ib_bdy)) )82 CASE('neumann','runoff')83 llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:) ! possibly every direction, T points84 llrecv1(:) = llrecv1(:) .OR. lrecv_bdyint(ib_bdy,1,:) ! possibly every direction, T points85 CASE('orlanski', 'orlanski_npo')86 llsend1(:) = llsend1(:) .OR. lsend_bdy(ib_bdy,1,:) ! possibly every direction, T points87 llrecv1(:) = llrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:) ! possibly every direction, T points88 END SELECT89 END DO90 IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN ! if need to send/recv in at least one direction91 CALL lbc_bdy_lnk( 'bdytra', llsend1, llrecv1, tsa, 'T', 1. )92 END IF93 103 ! 94 104 END SUBROUTINE bdy_tra 95 105 96 106 97 SUBROUTINE bdy_rnf( idx, pta, jpa )107 SUBROUTINE bdy_rnf( idx, pta, jpa, llrim0 ) 98 108 !!---------------------------------------------------------------------- 99 109 !! *** SUBROUTINE bdy_rnf *** … … 104 114 !! 105 115 !!---------------------------------------------------------------------- 106 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 107 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pta ! tracer trend 108 INTEGER, INTENT(in) :: jpa ! TRA index 116 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 117 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pta ! tracer trend 118 INTEGER, INTENT(in) :: jpa ! TRA index 119 LOGICAL, INTENT(in) :: llrim0 ! indicate if rim 0 is treated 109 120 ! 110 121 INTEGER :: ib, ii, ij, igrd ! dummy loop indices … … 113 124 ! 114 125 igrd = 1 ! Everything is at T-points here 115 IF( jpa == jp_tem ) THEN 116 CALL bdy_nmn( idx, igrd, pta ) 117 ELSE IF( jpa == jp_sal ) THEN 118 DO ib = 1, idx%nblenrim(igrd) 126 IF( jpa == jp_tem ) THEN 127 CALL bdy_nmn( idx, igrd, pta, llrim0 ) 128 ELSE IF( jpa == jp_sal ) THEN 129 IF( .NOT. llrim0 ) RETURN 130 DO ib = 1, idx%nblenrim(igrd) ! if llrim0 then treat the whole rim 119 131 ii = idx%nbi(ib,igrd) 120 132 ij = idx%nbj(ib,igrd)
Note: See TracChangeset
for help on using the changeset viewer.
