Changeset 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
r4491 r6225 1 1 #define TWO_WAY 2 #undef DECAL_FEEDBACK 2 3 3 4 MODULE agrif_top_update 5 !!====================================================================== 6 !! *** MODULE agrif_top_update *** 7 !! AGRIF : 8 !!---------------------------------------------------------------------- 9 !! History : 10 !!---------------------------------------------------------------------- 4 11 5 12 #if defined key_agrif && defined key_top 6 13 USE par_oce 7 14 USE oce 15 USE par_trc 16 USE trc 8 17 USE dom_oce 9 18 USE agrif_oce 10 USE trc11 19 USE wrk_nemo 12 20 … … 16 24 PUBLIC Agrif_Update_Trc 17 25 18 INTEGER, PUBLIC :: nbcline_trc = 026 INTEGER, PUBLIC :: nbcline_trc = 0 !: ??? 19 27 20 28 !!---------------------------------------------------------------------- 21 !! NEMO/NST 3. 3 , NEMO Consortium (2010)29 !! NEMO/NST 3.7 , NEMO Consortium (2015) 22 30 !! $Id$ 23 31 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 24 32 !!---------------------------------------------------------------------- 25 26 CONTAINS 33 CONTAINS 27 34 28 35 SUBROUTINE Agrif_Update_Trc( kt ) 29 !!--------------------------------------------- 30 !! *** ROUTINE Agrif_Update_Trc *** 31 !!--------------------------------------------- 32 !! 33 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 36 !!---------------------------------------------------------------------- 37 !! *** ROUTINE Agrif_Update_Trc *** 38 !!---------------------------------------------------------------------- 39 INTEGER, INTENT(in) :: kt 40 !!---------------------------------------------------------------------- 41 ! 42 IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 43 #if defined TWO_WAY 42 44 Agrif_UseSpecialValueInUpdate = .TRUE. 43 Agrif_SpecialValueFineGrid = 0. 44 45 IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN 46 CALL Agrif_Update_Variable(ztra,trn_id, procname=updateTRC) 45 Agrif_SpecialValueFineGrid = 0._wp 46 ! 47 IF( MOD(nbcline_trc,nbclineupdate) == 0 ) THEN 48 # if ! defined DECAL_FEEDBACK 49 CALL Agrif_Update_Variable(trn_id, procname=updateTRC ) 50 # else 51 CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC ) 52 # endif 47 53 ELSE 48 CALL Agrif_Update_Variable(ztra,trn_id,locupdate=(/0,2/), procname=updateTRC) 54 # if ! defined DECAL_FEEDBACK 55 CALL Agrif_Update_Variable( trn_id, locupdate=(/0,2/), procname=updateTRC ) 56 # else 57 CALL Agrif_Update_Variable( trn_id, locupdate=(/1,2/), procname=updateTRC ) 58 # endif 49 59 ENDIF 50 60 ! 51 61 Agrif_UseSpecialValueInUpdate = .FALSE. 52 62 nbcline_trc = nbcline_trc + 1 53 54 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra )55 63 #endif 56 64 ! 57 65 END SUBROUTINE Agrif_Update_Trc 58 66 59 SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)60 !!---------------------------------------------61 !! *** ROUTINE UpdateTrc ***62 !!---------------------------------------------63 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n264 REAL, DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres65 LOGICAL, INTENT(in) :: before66 67 INTEGER :: ji,jj,jk,jn68 67 69 IF( before ) THEN 70 DO jn = n1, n2 68 SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 69 !!---------------------------------------------------------------------- 70 !! *** ROUTINE updateT *** 71 !!---------------------------------------------------------------------- 72 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 73 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 74 LOGICAL , INTENT(in ) :: before 75 !! 76 INTEGER :: ji, jj, jk, jn 77 !!---------------------------------------------------------------------- 78 ! 79 IF( before ) THEN 80 ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 81 ELSE 82 IF( .NOT.(lk_agrif_fstep.AND.(neuler==0)) ) THEN 83 ! Add asselin part 84 DO jn = n1,n2 71 85 DO jk = k1, k2 72 86 DO jj = j1, j2 73 87 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 81 ! 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) 88 IF( ptab(ji,jj,jk,jn) /= 0._wp ) THEN 89 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 90 & + atfp * ( ptab(ji,jj,jk,jn) & 91 & - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 103 92 ENDIF 104 END DO105 END DO106 END DO107 END DO93 END DO 94 END DO 95 END DO 96 END DO 108 97 ENDIF 109 98 DO jn = n1, n2 99 DO jk = k1, k2 100 DO jj = j1, j2 101 DO ji = i1, i2 102 IF( ptab(ji,jj,jk,jn) /= 0._wp ) THEN 103 trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) * tmask(ji,jj,jk) 104 END IF 105 END DO 106 END DO 107 END DO 108 END DO 109 ENDIF 110 ! 110 111 END SUBROUTINE updateTRC 111 112 … … 119 120 END SUBROUTINE agrif_top_update_empty 120 121 #endif 121 END Module agrif_top_update 122 123 !!====================================================================== 124 END MODULE agrif_top_update
Note: See TracChangeset
for help on using the changeset viewer.
