- Timestamp:
- 2011-10-22T15:46:41+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r2715 r2977 30 30 !!--------------------------------------------- 31 31 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 32 USE wrk_nemo, ONLY: wrk_ 3d_132 USE wrk_nemo, ONLY: wrk_4d_1 33 33 !! 34 34 INTEGER, INTENT(in) :: kt 35 REAL(wp), POINTER, DIMENSION(:,:,: ) :: ztab35 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 36 36 37 37 38 38 IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 39 39 #if defined TWO_WAY 40 ztab => wrk_3d_1 41 IF( wrk_in_use(3, 1) ) THEN 40 IF( wrk_in_use(4, 1) ) THEN 42 41 CALL ctl_stop('agrif_update_tra: ERROR: requested workspace arrays unavailable') 43 42 RETURN 44 43 END IF 44 ztab => wrk_4d_1 45 45 46 46 Agrif_UseSpecialValueInUpdate = .TRUE. … … 48 48 49 49 IF (MOD(nbcline,nbclineupdate) == 0) THEN 50 CALL Agrif_Update_Variable(ztab,tn_id, procname=updateT) 51 CALL Agrif_Update_Variable(ztab,sn_id, procname=updateS) 52 ELSE 53 CALL Agrif_Update_Variable(ztab,tn_id,locupdate=(/0,2/), procname=updateT) 54 CALL Agrif_Update_Variable(ztab,sn_id,locupdate=(/0,2/), procname=updateS) 50 CALL Agrif_Update_Variable(ztab,tsn_id, procname=updateTS) 51 ELSE 52 CALL Agrif_Update_Variable(ztab,tsn_id,locupdate=(/0,2/), procname=updateTS) 55 53 ENDIF 56 54 57 55 Agrif_UseSpecialValueInUpdate = .FALSE. 58 56 59 IF( wrk_not_released( 3, 1) ) THEN57 IF( wrk_not_released(4, 1) ) THEN 60 58 CALL ctl_stop('Agrif_Update_Tra: ERROR: failed to release workspace arrays') 61 59 END IF … … 124 122 END SUBROUTINE recompute_diags 125 123 126 SUBROUTINE updateT ( tabres, i1, i2, j1, j2, k1, k2, before )124 SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 127 125 !!--------------------------------------------- 128 126 !! *** ROUTINE updateT *** … … 130 128 # include "domzgr_substitute.h90" 131 129 132 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 133 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2 ), INTENT(inout) :: tabres130 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 131 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 134 132 LOGICAL, iNTENT(in) :: before 135 133 136 INTEGER :: ji,jj,jk 137 138 IF (before) THEN 139 DO jk=k1,k2 140 DO jj=j1,j2 141 DO ji=i1,i2 142 tabres(ji,jj,jk) = tn(ji,jj,jk) 143 END DO 144 END DO 145 END DO 146 ELSE 147 DO jk=k1,k2 148 DO jj=j1,j2 149 DO ji=i1,i2 150 IF( tabres(ji,jj,jk) .NE. 0. ) THEN 151 tn(ji,jj,jk) = tabres(ji,jj,jk) * tmask(ji,jj,jk) 152 ENDIF 153 END DO 154 END DO 155 END DO 156 ENDIF 157 158 END SUBROUTINE updateT 159 160 SUBROUTINE updateS( tabres, i1, i2, j1, j2, k1, k2, before ) 161 !!--------------------------------------------- 162 !! *** ROUTINE updateS *** 163 !!--------------------------------------------- 164 # include "domzgr_substitute.h90" 165 166 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 167 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 168 LOGICAL, iNTENT(in) :: before 169 170 INTEGER :: ji,jj,jk 171 172 IF (before) THEN 173 DO jk=k1,k2 174 DO jj=j1,j2 175 DO ji=i1,i2 176 tabres(ji,jj,jk) = sn(ji,jj,jk) 177 END DO 178 END DO 179 END DO 180 ELSE 181 DO jk=k1,k2 182 DO jj=j1,j2 183 DO ji=i1,i2 184 IF (tabres(ji,jj,jk).NE.0.) THEN 185 sn(ji,jj,jk) = tabres(ji,jj,jk) * tmask(ji,jj,jk) 186 ENDIF 187 END DO 188 END DO 189 END DO 190 ENDIF 191 192 END SUBROUTINE updateS 134 INTEGER :: ji,jj,jk,jn 135 136 IF (before) THEN 137 DO jn = n1,n2 138 DO jk=k1,k2 139 DO jj=j1,j2 140 DO ji=i1,i2 141 tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) 142 END DO 143 END DO 144 END DO 145 END DO 146 ELSE 147 DO jn = n1,n2 148 DO jk=k1,k2 149 DO jj=j1,j2 150 DO ji=i1,i2 151 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 152 tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 153 END IF 154 END DO 155 END DO 156 END DO 157 END DO 158 ENDIF 159 160 END SUBROUTINE updateTS 193 161 194 162 SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before )
Note: See TracChangeset
for help on using the changeset viewer.