Changeset 636 for trunk/NEMO/NST_SRC/agrif_top_interp.F90
- Timestamp:
- 2007-03-07T14:28:16+01:00 (17 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/NST_SRC/agrif_top_interp.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/NST_SRC/agrif_top_interp.F90
r628 r636 1 ! 2 Module agrif_top_interp 1 MODULE agrif_top_interp 3 2 #if defined key_agrif && defined key_passivetrc 4 5 6 7 8 USE trc9 3 USE par_oce 4 USE oce 5 USE dom_oce 6 USE sol_oce 7 USE trcstp 8 USE sms 10 9 11 CONTAINS12 SUBROUTINE Agrif_trc( kt )10 IMPLICIT NONE 11 PRIVATE 13 12 14 Implicit none 15 16 !! * Substitutions 13 PUBLIC Agrif_trc 14 15 CONTAINS 16 17 SUBROUTINE Agrif_trc( kt ) 18 !!--------------------------------------------- 19 !! *** ROUTINE Agrif_trc *** 20 !!--------------------------------------------- 17 21 # include "domzgr_substitute.h90" 18 22 # include "vectopt_loop_substitute.h90" 19 ! 20 INTEGER :: kt21 REAL(wp) tratemp(jpi,jpj,jpk,jptra) 23 24 INTEGER, INTENT(in) :: kt 25 22 26 INTEGER :: ji,jj,jk,jn 23 REAL(wp) :: rhox27 REAL(wp) :: zrhox 24 28 REAL(wp) :: alpha1, alpha2, alpha3, alpha4 25 29 REAL(wp) :: alpha5, alpha6, alpha7 26 ! 27 IF (Agrif_Root()) RETURN 30 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: ztra 31 32 IF (Agrif_Root()) RETURN 28 33 29 30 31 tratemp = 0.34 Agrif_SpecialValue=0. 35 Agrif_UseSpecialValue = .TRUE. 36 ztra = 0.e0 32 37 33 Call Agrif_Bc_variable(tratemp,trn) 34 Agrif_UseSpecialValue = .FALSE. 35 36 rhox = Agrif_Rhox() 37 38 alpha1 = (rhox-1.)/2. 39 alpha2 = 1.-alpha1 40 41 alpha3 = (rhox-1)/(rhox+1) 42 alpha4 = 1.-alpha3 43 44 alpha6 = 2.*(rhox-1.)/(rhox+1.) 45 alpha7 = -(rhox-1)/(rhox+3) 46 alpha5 = 1. - alpha6 - alpha7 47 48 ! 49 If ((nbondi == 1).OR.(nbondi == 2)) THEN 50 51 tra(nlci,:,:,:) = alpha1 * tratemp(nlci,:,:,:) + alpha2 * tratemp(nlci-1,:,:,:) 52 53 Do jn=1,jptra 54 Do jk=1,jpk 55 Do jj=1,jpj 56 IF (umask(nlci-2,jj,jk).EQ.0.) THEN 57 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 58 ELSE 59 tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 60 IF (un(nlci-2,jj,jk).GT.0.) THEN 61 tra(nlci-1,jj,jk,jn)=(alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn) & 62 +alpha7*tra(nlci-3,jj,jk,jn))*tmask(nlci-1,jj,jk) 63 ENDIF 64 ENDIF 65 End Do 66 enddo 67 END DO 68 ENDIF 69 70 If ((nbondj == 1).OR.(nbondj == 2)) THEN 71 72 tra(:,nlcj,:,:) = alpha1 * tratemp(:,nlcj,:,:) + alpha2 * tratemp(:,nlcj-1,:,:) 73 74 DO jn=1, jptra 75 Do jk=1,jpk 76 Do ji=1,jpi 77 IF (vmask(ji,nlcj-2,jk).EQ.0.) THEN 78 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 79 ELSE 80 tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 81 IF (vn(ji,nlcj-2,jk) .GT. 0.) THEN 82 tra(ji,nlcj-1,jk,jn)=(alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn) & 83 +alpha7*tra(ji,nlcj-3,jk,jn))*tmask(ji,nlcj-1,jk) 84 ENDIF 85 ENDIF 86 End Do 87 enddo 88 END DO 38 CALL Agrif_Bc_variable(ztra,trn) 39 Agrif_UseSpecialValue = .FALSE. 40 41 zrhox = Agrif_Rhox() 42 43 alpha1 = (zrhox-1.)/2. 44 alpha2 = 1.-alpha1 45 46 alpha3 = (zrhox-1)/(zrhox+1) 47 alpha4 = 1.-alpha3 48 49 alpha6 = 2.*(zrhox-1.)/(zrhox+1.) 50 alpha7 = -(zrhox-1)/(zrhox+3) 51 alpha5 = 1. - alpha6 - alpha7 52 53 IF ((nbondi == 1).OR.(nbondi == 2)) THEN 54 tra(nlci,:,:,:) = alpha1 * ztra(nlci,:,:,:) + alpha2 * ztra(nlci-1,:,:,:) 55 DO jn=1,jptra 56 DO jk=1,jpk 57 DO jj=1,jpj 58 IF (umask(nlci-2,jj,jk).EQ.0.) THEN 59 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 60 ELSE 61 tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 62 IF (un(nlci-2,jj,jk).GT.0.) THEN 63 tra(nlci-1,jj,jk,jn)=(alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn) & 64 +alpha7*tra(nlci-3,jj,jk,jn))*tmask(nlci-1,jj,jk) 65 ENDIF 66 ENDIF 67 END DO 68 END DO 69 END DO 70 ENDIF 71 72 IF ((nbondj == 1).OR.(nbondj == 2)) THEN 73 tra(:,nlcj,:,:) = alpha1 * ztra(:,nlcj,:,:) + alpha2 * ztra(:,nlcj-1,:,:) 74 DO jn=1, jptra 75 DO jk=1,jpk 76 DO ji=1,jpi 77 IF (vmask(ji,nlcj-2,jk).EQ.0.) THEN 78 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 79 ELSE 80 tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 81 IF (vn(ji,nlcj-2,jk) .GT. 0.) THEN 82 tra(ji,nlcj-1,jk,jn)=(alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn) & 83 +alpha7*tra(ji,nlcj-3,jk,jn))*tmask(ji,nlcj-1,jk) 84 ENDIF 85 ENDIF 86 END DO 87 END DO 88 END DO 89 89 ENDIF 90 90 91 91 IF ((nbondi == -1).OR.(nbondi == 2)) THEN 92 93 tra(1,:,:,:) = alpha1 * tratemp(1,:,:,:) + alpha2 * tratemp(2,:,:,:) 94 95 DO jn=1, jptra 96 Do jk=1,jpk 97 Do jj=1,jpj 98 IF (umask(2,jj,jk).EQ.0.) THEN 99 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 100 ELSE 101 tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 102 IF (un(2,jj,jk).LT.0.) THEN 103 tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn) & 92 tra(1,:,:,:) = alpha1 * ztra(1,:,:,:) + alpha2 * ztra(2,:,:,:) 93 DO jn=1, jptra 94 DO jk=1,jpk 95 DO jj=1,jpj 96 IF (umask(2,jj,jk).EQ.0.) THEN 97 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 98 ELSE 99 tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 100 IF (un(2,jj,jk).LT.0.) THEN 101 tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn) & 104 102 +alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 105 ENDIF 106 ENDIF 107 End Do 108 enddo 109 END DO 110 ENDIF 111 IF ((nbondj == -1).OR.(nbondj == 2)) THEN 112 113 tra(:,1,:,:) = alpha1 * tratemp(:,1,:,:) + alpha2 * tratemp(:,2,:,:) 114 115 DO jn=1, jptra 116 Do jk=1,jpk 117 Do ji=1,jpi 118 IF (vmask(ji,2,jk).EQ.0.) THEN 119 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 120 ELSE 121 tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 122 IF (vn(ji,2,jk) .LT. 0.) THEN 123 tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)& 124 +alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 125 ENDIF 126 ENDIF 127 End Do 128 enddo 129 END DO 103 ENDIF 104 ENDIF 105 END DO 106 END DO 107 END DO 130 108 ENDIF 131 109 132 End Subroutine Agrif_trc 133 ! 134 ! 110 IF ((nbondj == -1).OR.(nbondj == 2)) THEN 111 tra(:,1,:,:) = alpha1 * ztra(:,1,:,:) + alpha2 * ztra(:,2,:,:) 112 DO jn=1, jptra 113 DO jk=1,jpk 114 DO ji=1,jpi 115 IF (vmask(ji,2,jk).EQ.0.) THEN 116 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 117 ELSE 118 tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 119 IF (vn(ji,2,jk) .LT. 0.) THEN 120 tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)& 121 +alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 122 ENDIF 123 ENDIF 124 END DO 125 END DO 126 END DO 127 ENDIF 135 128 129 END SUBROUTINE Agrif_trc 136 130 137 131 #else 138 CONTAINS 139 subroutine Agrif_TOP_Interp_empty 132 CONTAINS 133 SUBROUTINE Agrif_TOP_Interp_empty 134 !!--------------------------------------------- 135 !! *** ROUTINE agrif_Top_Interp_empty *** 136 !!--------------------------------------------- 137 WRITE(*,*) 'agrif_top_interp : You should not have seen this print! error?' 138 END SUBROUTINE Agrif_TOP_Interp_empty 139 #endif 140 END MODULE agrif_top_interp 140 141 141 end subroutine Agrif_TOP_Interp_empty142 #endif143 End Module agrif_top_interp144
Note: See TracChangeset
for help on using the changeset viewer.
