Changeset 2789 for branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
- Timestamp:
- 2011-06-27T13:18:25+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r2715 r2789 48 48 !!---------------------------------------------------------------------- 49 49 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 50 USE wrk_nemo, ONLY: wrk_ 3d_1, wrk_3d_250 USE wrk_nemo, ONLY: wrk_4d_1 51 51 !! 52 INTEGER :: ji, jj, jk ! dummy loop indices52 INTEGER :: ji, jj, jk, jn ! dummy loop indices 53 53 REAL(wp) :: zrhox , alpha1, alpha2, alpha3 54 54 REAL(wp) :: alpha4, alpha5, alpha6, alpha7 55 REAL(wp), POINTER, DIMENSION(:,:,: ) :: zta, zsa55 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsa 56 56 !!---------------------------------------------------------------------- 57 57 ! 58 58 IF( Agrif_Root() ) RETURN 59 59 60 zt a => wrk_3d_1 ; zsa => wrk_3d_261 IF( wrk_in_use( 3, 1,2) )THEN60 ztsa => wrk_4d_1 61 IF( wrk_in_use(4, 1) )THEN 62 62 CALL ctl_stop('agrif_tra: requested workspace arrays unavailable.') 63 63 RETURN … … 66 66 Agrif_SpecialValue = 0.e0 67 67 Agrif_UseSpecialValue = .TRUE. 68 zta(:,:,:) = 0.e0 69 zsa(:,:,:) = 0.e0 70 71 CALL Agrif_Bc_variable( zta, tn_id, procname = interptn ) 72 CALL Agrif_Bc_variable( zsa, sn_id, procname = interpsn ) 68 ztsa(:,:,:,:) = 0.e0 69 70 CALL Agrif_Bc_variable( ztsa, tsn_id, procname=interptsn ) 73 71 Agrif_UseSpecialValue = .FALSE. 74 72 … … 87 85 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 88 86 89 ta(nlci,:,:) = alpha1 * zta(nlci,:,:) + alpha2 * zta(nlci-1,:,:) 90 sa(nlci,:,:) = alpha1 * zsa(nlci,:,:) + alpha2 * zsa(nlci-1,:,:) 91 92 DO jk = 1, jpkm1 93 DO jj = 1, jpj 94 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 95 ta(nlci-1,jj,jk) = ta(nlci,jj,jk) * tmask(nlci-1,jj,jk) 96 sa(nlci-1,jj,jk) = sa(nlci,jj,jk) * tmask(nlci-1,jj,jk) 97 ELSE 98 ta(nlci-1,jj,jk)=(alpha4*ta(nlci,jj,jk)+alpha3*ta(nlci-2,jj,jk))*tmask(nlci-1,jj,jk) 99 sa(nlci-1,jj,jk)=(alpha4*sa(nlci,jj,jk)+alpha3*sa(nlci-2,jj,jk))*tmask(nlci-1,jj,jk) 100 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 101 ta(nlci-1,jj,jk)=( alpha6*ta(nlci-2,jj,jk)+alpha5*ta(nlci,jj,jk) & 102 & + alpha7*ta(nlci-3,jj,jk) ) * tmask(nlci-1,jj,jk) 103 sa(nlci-1,jj,jk)=( alpha6*sa(nlci-2,jj,jk)+alpha5*sa(nlci,jj,jk) & 104 & + alpha7*sa(nlci-3,jj,jk) ) * tmask(nlci-1,jj,jk) 87 DO jn = 1, jpts 88 tsa(nlci,:,:,jn) = alpha1 * ztsa(nlci,:,:,jn) + alpha2 * ztsa(nlci-1,:,:,jn) 89 DO jk = 1, jpkm1 90 DO jj = 1, jpj 91 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 92 tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 93 ELSE 94 tsa(nlci-1,jj,jk,jn)=(alpha4*tsa(nlci,jj,jk,jn)+alpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 95 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 96 tsa(nlci-1,jj,jk,jn)=( alpha6*tsa(nlci-2,jj,jk,jn)+alpha5*tsa(nlci,jj,jk,jn) & 97 & + alpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 98 ENDIF 105 99 ENDIF 106 END IF107 END DO 108 END 100 END DO 101 END DO 102 ENDDO 109 103 ENDIF 110 104 111 105 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 112 106 113 ta(:,nlcj,:) = alpha1 * zta(:,nlcj,:) + alpha2 * zta(:,nlcj-1,:) 114 sa(:,nlcj,:) = alpha1 * zsa(:,nlcj,:) + alpha2 * zsa(:,nlcj-1,:) 115 116 DO jk = 1, jpkm1 117 DO ji = 1, jpi 118 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 119 ta(ji,nlcj-1,jk) = ta(ji,nlcj,jk) * tmask(ji,nlcj-1,jk) 120 sa(ji,nlcj-1,jk) = sa(ji,nlcj,jk) * tmask(ji,nlcj-1,jk) 121 ELSE 122 ta(ji,nlcj-1,jk)=(alpha4*ta(ji,nlcj,jk)+alpha3*ta(ji,nlcj-2,jk))*tmask(ji,nlcj-1,jk) 123 sa(ji,nlcj-1,jk)=(alpha4*sa(ji,nlcj,jk)+alpha3*sa(ji,nlcj-2,jk))*tmask(ji,nlcj-1,jk) 124 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 125 ta(ji,nlcj-1,jk)=( alpha6*ta(ji,nlcj-2,jk)+alpha5*ta(ji,nlcj,jk) & 126 & + alpha7*ta(ji,nlcj-3,jk) ) * tmask(ji,nlcj-1,jk) 127 sa(ji,nlcj-1,jk)=( alpha6*sa(ji,nlcj-2,jk)+alpha5*sa(ji,nlcj,jk) & 128 & + alpha7*sa(ji,nlcj-3,jk))*tmask(ji,nlcj-1,jk) 107 DO jn = 1, jpts 108 tsa(:,nlcj,:,jn) = alpha1 * ztsa(:,nlcj,:,jn) + alpha2 * ztsa(:,nlcj-1,:,jn) 109 DO jk = 1, jpkm1 110 DO ji = 1, jpi 111 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 112 tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 113 ELSE 114 tsa(ji,nlcj-1,jk,jn)=(alpha4*tsa(ji,nlcj,jk,jn)+alpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 115 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 116 tsa(ji,nlcj-1,jk,jn)=( alpha6*tsa(ji,nlcj-2,jk,jn)+alpha5*tsa(ji,nlcj,jk,jn) & 117 & + alpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 118 ENDIF 129 119 ENDIF 130 END IF131 END DO 132 END DO120 END DO 121 END DO 122 ENDDO 133 123 ENDIF 134 124 135 125 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 136 ta(1,:,:) = alpha1 * zta(1,:,:) + alpha2 * zta(2,:,:) 137 sa(1,:,:) = alpha1 * zsa(1,:,:) + alpha2 * zsa(2,:,:) 138 DO jk = 1, jpkm1 139 DO jj = 1, jpj 140 IF( umask(2,jj,jk) == 0.e0 ) THEN 141 ta(2,jj,jk) = ta(1,jj,jk) * tmask(2,jj,jk) 142 sa(2,jj,jk) = sa(1,jj,jk) * tmask(2,jj,jk) 143 ELSE 144 ta(2,jj,jk)=(alpha4*ta(1,jj,jk)+alpha3*ta(3,jj,jk))*tmask(2,jj,jk) 145 sa(2,jj,jk)=(alpha4*sa(1,jj,jk)+alpha3*sa(3,jj,jk))*tmask(2,jj,jk) 146 IF( un(2,jj,jk) < 0.e0 ) THEN 147 ta(2,jj,jk)=(alpha6*ta(3,jj,jk)+alpha5*ta(1,jj,jk)+alpha7*ta(4,jj,jk))*tmask(2,jj,jk) 148 sa(2,jj,jk)=(alpha6*sa(3,jj,jk)+alpha5*sa(1,jj,jk)+alpha7*sa(4,jj,jk))*tmask(2,jj,jk) 126 DO jn = 1, jpts 127 tsa(1,:,:,jn) = alpha1 * ztsa(1,:,:,jn) + alpha2 * ztsa(2,:,:,jn) 128 DO jk = 1, jpkm1 129 DO jj = 1, jpj 130 IF( umask(2,jj,jk) == 0.e0 ) THEN 131 tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 132 ELSE 133 tsa(2,jj,jk,jn)=(alpha4*tsa(1,jj,jk,jn)+alpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk) 134 IF( un(2,jj,jk) < 0.e0 ) THEN 135 tsa(2,jj,jk,jn)=(alpha6*tsa(3,jj,jk,jn)+alpha5*tsa(1,jj,jk,jn)+alpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 136 ENDIF 149 137 ENDIF 150 END IF138 END DO 151 139 END DO 152 140 END DO … … 154 142 155 143 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 156 ta(:,1,:) = alpha1 * zta(:,1,:) + alpha2 * zta(:,2,:) 157 sa(:,1,:) = alpha1 * zsa(:,1,:) + alpha2 * zsa(:,2,:) 158 DO jk=1,jpk 159 DO ji=1,jpi 160 IF( vmask(ji,2,jk) == 0.e0 ) THEN 161 ta(ji,2,jk)=ta(ji,1,jk) * tmask(ji,2,jk) 162 sa(ji,2,jk)=sa(ji,1,jk) * tmask(ji,2,jk) 163 ELSE 164 ta(ji,2,jk)=(alpha4*ta(ji,1,jk)+alpha3*ta(ji,3,jk))*tmask(ji,2,jk) 165 sa(ji,2,jk)=(alpha4*sa(ji,1,jk)+alpha3*sa(ji,3,jk))*tmask(ji,2,jk) 166 IF( vn(ji,2,jk) < 0.e0 ) THEN 167 ta(ji,2,jk)=(alpha6*ta(ji,3,jk)+alpha5*ta(ji,1,jk)+alpha7*ta(ji,4,jk))*tmask(ji,2,jk) 168 sa(ji,2,jk)=(alpha6*sa(ji,3,jk)+alpha5*sa(ji,1,jk)+alpha7*sa(ji,4,jk))*tmask(ji,2,jk) 144 DO jn = 1, jpts 145 tsa(:,1,:,jn) = alpha1 * ztsa(:,1,:,jn) + alpha2 * ztsa(:,2,:,jn) 146 DO jk=1,jpk 147 DO ji=1,jpi 148 IF( vmask(ji,2,jk) == 0.e0 ) THEN 149 tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 150 ELSE 151 tsa(ji,2,jk,jn)=(alpha4*tsa(ji,1,jk,jn)+alpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 152 IF( vn(ji,2,jk) < 0.e0 ) THEN 153 tsa(ji,2,jk,jn)=(alpha6*tsa(ji,3,jk,jn)+alpha5*tsa(ji,1,jk,jn)+alpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 154 ENDIF 169 155 ENDIF 170 END IF171 END DO 172 END 156 END DO 157 END DO 158 ENDDO 173 159 ENDIF 174 160 ! 175 IF( wrk_not_released( 3, 1,2) ) THEN161 IF( wrk_not_released(4, 1) ) THEN 176 162 CALL ctl_stop('agrif_tra: failed to release workspace arrays.') 177 163 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
