- Timestamp:
- 2014-09-25T18:26:34+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
r4491 r4789 24 24 !!---------------------------------------------------------------------- 25 25 26 26 CONTAINS 27 27 28 28 SUBROUTINE Agrif_Update_Trc( kt ) … … 30 30 !! *** ROUTINE Agrif_Update_Trc *** 31 31 !!--------------------------------------------- 32 !!33 32 INTEGER, INTENT(in) :: kt 34 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra 35 36 37 IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 38 39 #if defined TWO_WAY 40 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra ) 41 33 !!--------------------------------------------- 34 ! 35 IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 36 #if defined TWO_WAY 42 37 Agrif_UseSpecialValueInUpdate = .TRUE. 43 38 Agrif_SpecialValueFineGrid = 0. 44 45 IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN 46 CALL Agrif_Update_Variable(ztra,trn_id, procname=updateTRC) 39 ! 40 IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN 41 # if ! defined DECAL_FEEDBACK 42 CALL Agrif_Update_Variable(trn_id, procname=updateTRC) 43 # else 44 CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC) 45 # endif 47 46 ELSE 48 CALL Agrif_Update_Variable(ztra,trn_id,locupdate=(/0,2/), procname=updateTRC) 47 # if ! defined DECAL_FEEDBACK 48 CALL Agrif_Update_Variable(trn_id,locupdate=(/0,2/), procname=updateTRC) 49 # else 50 CALL Agrif_Update_Variable(trn_id,locupdate=(/1,2/), procname=updateTRC) 51 # endif 49 52 ENDIF 50 53 ! 51 54 Agrif_UseSpecialValueInUpdate = .FALSE. 52 55 nbcline_trc = nbcline_trc + 1 53 54 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra )55 56 #endif 56 57 ! 57 58 END SUBROUTINE Agrif_Update_Trc 58 59 59 SUBROUTINE updateTRC( tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)60 SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 60 61 !!--------------------------------------------- 61 !! *** ROUTINE UpdateTrc***62 !! *** ROUTINE updateT *** 62 63 !!--------------------------------------------- 64 # include "domzgr_substitute.h90" 63 65 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 64 REAL , DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres66 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 65 67 LOGICAL, INTENT(in) :: before 66 68 !! 67 69 INTEGER :: ji,jj,jk,jn 68 69 IF( before ) THEN 70 DO jn = n1, n2 71 DO jk = k1, k2 72 DO jj = j1, j2 73 DO ji = i1, i2 74 tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 75 ENDDO 76 ENDDO 77 ENDDO 78 ENDDO 79 ELSE 80 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 70 !!--------------------------------------------- 71 ! 72 IF (before) THEN 73 DO jn = n1,n2 74 DO jk=k1,k2 75 DO jj=j1,j2 76 DO ji=i1,i2 77 ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 78 END DO 79 END DO 80 END DO 81 END DO 82 ELSE 83 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 81 84 ! Add asselin part 82 DO jn = n1, n2 83 DO jk = k1, k2 84 DO jj = j1, j2 85 DO ji = i1, i2 86 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 87 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 88 & + atfp * ( tabres(ji,jj,jk,jn) & 89 - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 90 ENDIF 91 ENDDO 92 ENDDO 93 ENDDO 94 ENDDO 95 ENDIF 96 97 DO jn = n1, n2 98 DO jk = k1, k2 99 DO jj = j1, j2 100 DO ji = i1, i2 101 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 102 trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 85 DO jn = n1,n2 86 DO jk=k1,k2 87 DO jj=j1,j2 88 DO ji=i1,i2 89 IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN 90 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 91 & + atfp * ( ptab(ji,jj,jk,jn) & 92 & - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 103 93 ENDIF 104 94 ENDDO … … 107 97 ENDDO 108 98 ENDIF 109 99 DO jn = n1,n2 100 DO jk=k1,k2 101 DO jj=j1,j2 102 DO ji=i1,i2 103 IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN 104 trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) * tmask(ji,jj,jk) 105 END IF 106 END DO 107 END DO 108 END DO 109 END DO 110 ENDIF 111 ! 110 112 END SUBROUTINE updateTRC 111 113 … … 119 121 END SUBROUTINE agrif_top_update_empty 120 122 #endif 121 END M oduleagrif_top_update123 END MODULE agrif_top_update
Note: See TracChangeset
for help on using the changeset viewer.