- Timestamp:
- 2012-11-26T11:58:31+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_LOCEAN_UKMO_2012/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
r3294 r3653 27 27 28 28 SUBROUTINE Agrif_trc 29 !!--------------------------------------------- 30 !! *** ROUTINE Agrif_trc *** 31 !!--------------------------------------------- 32 33 INTEGER :: ji,jj,jk,jn 34 REAL(wp) :: zrhox 35 REAL(wp) :: alpha1, alpha2, alpha3, alpha4 36 REAL(wp) :: alpha5, alpha6, alpha7 29 !!---------------------------------------------------------------------- 30 !! *** ROUTINE Agrif_Tra *** 31 !!---------------------------------------------------------------------- 32 !! 33 INTEGER :: ji, jj, jk, jn ! dummy loop indices 34 REAL(wp) :: zrhox , alpha1, alpha2, alpha3 35 REAL(wp) :: alpha4, alpha5, alpha6, alpha7 37 36 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra 38 39 IF (Agrif_Root()) RETURN 37 !!---------------------------------------------------------------------- 38 ! 39 IF( Agrif_Root() ) RETURN 40 40 41 41 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra ) 42 42 43 Agrif_SpecialValue =0.43 Agrif_SpecialValue = 0.e0 44 44 Agrif_UseSpecialValue = .TRUE. 45 ztra = 0.e045 ztra(:,:,:,:) = 0.e0 46 46 47 CALL Agrif_Bc_variable( ztra,trn_id, procname =interptrn )47 CALL Agrif_Bc_variable( ztra, trn_id, procname=interptrn ) 48 48 Agrif_UseSpecialValue = .FALSE. 49 49 50 50 zrhox = Agrif_Rhox() 51 51 52 alpha1 = ( zrhox-1.)/2.53 alpha2 = 1. -alpha152 alpha1 = ( zrhox - 1. ) * 0.5 53 alpha2 = 1. - alpha1 54 54 55 alpha3 = ( zrhox-1)/(zrhox+1)56 alpha4 = 1. -alpha355 alpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 56 alpha4 = 1. - alpha3 57 57 58 alpha6 = 2. *(zrhox-1.)/(zrhox+1.)59 alpha7 = -(zrhox-1)/(zrhox+3)58 alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 59 alpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 60 60 alpha5 = 1. - alpha6 - alpha7 61 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 61 62 62 IF ((nbondi == 1).OR.(nbondi == 2)) THEN 63 tra(nlci,:,:,:) = alpha1 * ztra(nlci,:,:,:) + alpha2 * ztra(nlci-1,:,:,:) 64 DO jn=1,jptra 65 DO jk=1,jpk 66 DO jj=1,jpj 67 IF (umask(nlci-2,jj,jk).EQ.0.) THEN 63 DO jn = 1, jptra 64 tra(nlci,:,:,jn) = alpha1 * ztra(nlci,:,:,jn) + alpha2 * ztra(nlci-1,:,:,jn) 65 DO jk = 1, jpkm1 66 DO jj = 1, jpj 67 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 68 68 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 69 69 ELSE 70 70 tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 71 IF (un(nlci-2,jj,jk).GT.0.) THEN 72 tra(nlci-1,jj,jk,jn)=(alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn) & 73 +alpha7*tra(nlci-3,jj,jk,jn))*tmask(nlci-1,jj,jk) 71 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 72 tra(nlci-1,jj,jk,jn)=( alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn) & 73 & + alpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 74 ENDIF 75 ENDIF 76 END DO 77 END DO 78 ENDDO 79 ENDIF 80 81 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 82 83 DO jn = 1, jptra 84 tra(:,nlcj,:,jn) = alpha1 * ztra(:,nlcj,:,jn) + alpha2 * ztra(:,nlcj-1,:,jn) 85 DO jk = 1, jpkm1 86 DO ji = 1, jpi 87 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 88 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 89 ELSE 90 tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 91 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 92 tra(ji,nlcj-1,jk,jn)=( alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn) & 93 & + alpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 94 ENDIF 95 ENDIF 96 END DO 97 END DO 98 ENDDO 99 ENDIF 100 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 101 DO jn = 1, jptra 102 tra(1,:,:,jn) = alpha1 * ztra(1,:,:,jn) + alpha2 * ztra(2,:,:,jn) 103 DO jk = 1, jpkm1 104 DO jj = 1, jpj 105 IF( umask(2,jj,jk) == 0.e0 ) THEN 106 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 107 ELSE 108 tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 109 IF( un(2,jj,jk) < 0.e0 ) THEN 110 tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn)+alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 74 111 ENDIF 75 112 ENDIF … … 79 116 ENDIF 80 117 81 IF ((nbondj == 1).OR.(nbondj == 2)) THEN82 tra(:,nlcj,:,:) = alpha1 * ztra(:,nlcj,:,:) + alpha2 * ztra(:,nlcj-1,:,:)83 DO jn=1, jptra84 DO jk=1,jpk 118 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 119 DO jn = 1, jptra 120 tra(:,1,:,jn) = alpha1 * ztra(:,1,:,jn) + alpha2 * ztra(:,2,:,jn) 121 DO jk=1,jpk 85 122 DO ji=1,jpi 86 IF (vmask(ji,nlcj-2,jk).EQ.0.) THEN87 tra(ji, nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)123 IF( vmask(ji,2,jk) == 0.e0 ) THEN 124 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 88 125 ELSE 89 tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 90 IF (vn(ji,nlcj-2,jk) .GT. 0.) THEN 91 tra(ji,nlcj-1,jk,jn)=(alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn) & 92 +alpha7*tra(ji,nlcj-3,jk,jn))*tmask(ji,nlcj-1,jk) 126 tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 127 IF( vn(ji,2,jk) < 0.e0 ) THEN 128 tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)+alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 93 129 ENDIF 94 130 ENDIF 95 131 END DO 96 132 END DO 97 END 133 ENDDO 98 134 ENDIF 99 100 IF ((nbondi == -1).OR.(nbondi == 2)) THEN 101 tra(1,:,:,:) = alpha1 * ztra(1,:,:,:) + alpha2 * ztra(2,:,:,:) 102 DO jn=1, jptra 103 DO jk=1,jpk 104 DO jj=1,jpj 105 IF (umask(2,jj,jk).EQ.0.) THEN 106 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 107 ELSE 108 tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 109 IF (un(2,jj,jk).LT.0.) THEN 110 tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn) & 111 +alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 112 ENDIF 113 ENDIF 114 END DO 115 END DO 116 END DO 117 ENDIF 118 119 IF ((nbondj == -1).OR.(nbondj == 2)) THEN 120 tra(:,1,:,:) = alpha1 * ztra(:,1,:,:) + alpha2 * ztra(:,2,:,:) 121 DO jn=1, jptra 122 DO jk=1,jpk 123 DO ji=1,jpi 124 IF (vmask(ji,2,jk).EQ.0.) THEN 125 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 126 ELSE 127 tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 128 IF (vn(ji,2,jk) .LT. 0.) THEN 129 tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)& 130 +alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 131 ENDIF 132 ENDIF 133 END DO 134 END DO 135 END DO 136 ENDIF 137 135 ! 138 136 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra ) 137 ! 139 138 140 139 END SUBROUTINE Agrif_trc
Note: See TracChangeset
for help on using the changeset viewer.
