- Timestamp:
- 2016-01-04T14:47:06+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
r4491 r6204 1 1 #define TWO_WAY 2 #undef DECAL_FEEDBACK 2 3 3 4 MODULE agrif_top_update … … 8 9 USE dom_oce 9 10 USE agrif_oce 11 USE par_trc 10 12 USE trc 11 13 USE wrk_nemo … … 24 26 !!---------------------------------------------------------------------- 25 27 26 28 CONTAINS 27 29 28 30 SUBROUTINE Agrif_Update_Trc( kt ) … … 30 32 !! *** ROUTINE Agrif_Update_Trc *** 31 33 !!--------------------------------------------- 32 !!33 34 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 35 !!--------------------------------------------- 36 ! 37 IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 38 #if defined TWO_WAY 42 39 Agrif_UseSpecialValueInUpdate = .TRUE. 43 40 Agrif_SpecialValueFineGrid = 0. 44 45 IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN 46 CALL Agrif_Update_Variable(ztra,trn_id, procname=updateTRC) 41 ! 42 IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN 43 # if ! defined DECAL_FEEDBACK 44 CALL Agrif_Update_Variable(trn_id, procname=updateTRC) 45 # else 46 CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC) 47 # endif 47 48 ELSE 48 CALL Agrif_Update_Variable(ztra,trn_id,locupdate=(/0,2/), procname=updateTRC) 49 # if ! defined DECAL_FEEDBACK 50 CALL Agrif_Update_Variable(trn_id,locupdate=(/0,2/), procname=updateTRC) 51 # else 52 CALL Agrif_Update_Variable(trn_id,locupdate=(/1,2/), procname=updateTRC) 53 # endif 49 54 ENDIF 50 55 ! 51 56 Agrif_UseSpecialValueInUpdate = .FALSE. 52 57 nbcline_trc = nbcline_trc + 1 53 54 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra )55 58 #endif 56 59 ! 57 60 END SUBROUTINE Agrif_Update_Trc 58 61 59 SUBROUTINE updateTRC( tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)62 SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 60 63 !!--------------------------------------------- 61 !! *** ROUTINE UpdateTrc***64 !! *** ROUTINE updateT *** 62 65 !!--------------------------------------------- 66 # include "domzgr_substitute.h90" 63 67 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 64 REAL , DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres68 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 65 69 LOGICAL, INTENT(in) :: before 66 70 !! 67 71 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 72 !!--------------------------------------------- 73 ! 74 IF (before) THEN 75 DO jn = n1,n2 76 DO jk=k1,k2 77 DO jj=j1,j2 78 DO ji=i1,i2 79 ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 80 END DO 81 END DO 82 END DO 83 END DO 84 ELSE 85 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 81 86 ! 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) 87 DO jn = n1,n2 88 DO jk=k1,k2 89 DO jj=j1,j2 90 DO ji=i1,i2 91 IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN 92 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 93 & + atfp * ( ptab(ji,jj,jk,jn) & 94 & - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 103 95 ENDIF 104 96 ENDDO … … 107 99 ENDDO 108 100 ENDIF 109 101 DO jn = n1,n2 102 DO jk=k1,k2 103 DO jj=j1,j2 104 DO ji=i1,i2 105 IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN 106 trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) * tmask(ji,jj,jk) 107 END IF 108 END DO 109 END DO 110 END DO 111 END DO 112 ENDIF 113 ! 110 114 END SUBROUTINE updateTRC 111 115 … … 119 123 END SUBROUTINE agrif_top_update_empty 120 124 #endif 121 END M oduleagrif_top_update125 END MODULE agrif_top_update
Note: See TracChangeset
for help on using the changeset viewer.