Changeset 4739 for branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/src/med_red_seas.F90
- Timestamp:
- 2014-08-13T10:46:04+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/src/med_red_seas.F90
r4738 r4739 8 8 CONTAINS 9 9 10 SUBROUTINE med_red_dmp(presto )10 SUBROUTINE med_red_dmp(presto, jk, ln_31_lev) 11 11 !!------------------------------------ 12 12 !! **ROUTINE: med_red_dmp … … 17 17 !!----------------------------------- 18 18 INTEGER :: ij0,ij1,ii0,ii1,ji,jj 19 REAL(8), DIMENSION(:,:), ALLOCATABLE :: zmrs 20 REAL(8) :: zhfac, zsdmp, zbdmp 21 REAL(8), DIMENSION(jpi,jpj), INTENT(inout) :: presto 19 INTEGER, INTENT(in) :: jk 20 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zmrs 21 REAL(wp) :: zhfac, zsdmp, zbdmp 22 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: presto 23 LOGICAL, INTENT(in), OPTIONAL :: ln_31_lev 24 LOGICAL :: l_31_lev 22 25 23 26 WRITE(numout,*) 'ORCA Med and Red Seas Damping' 24 27 28 IF ( PRESENT(ln_31_lev)) THEN 29 l_31_lev = ln_31_lev 30 ELSE 31 l_31_lev = .false. 32 ENDIF 33 25 34 ALLOCATE( zmrs(jpi, jpj) ) 26 35 ! 27 zmrs(:,:) = 0. 36 zmrs(:,:) = 0._wp 28 37 ! 29 38 SELECT CASE ( jp_cfg ) … … 43 52 ! ! ======================= 44 53 ij0 = 96 ; ij1 = 110 ! Mediterranean Sea 45 ii0 = 157 ; ii1 = 181 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. 54 ii0 = 157 ; ii1 = 181 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp 46 55 ij0 = 100 ; ij1 = 110 47 ii0 = 144 ; ii1 = 156 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. 56 ii0 = 144 ; ii1 = 156 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp 48 57 ij0 = 100 ; ij1 = 103 49 ii0 = 139 ; ii1 = 143 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. 58 ii0 = 139 ; ii1 = 143 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp 50 59 ! 51 60 ij0 = 101 ; ij1 = 102 ! Decrease before Gibraltar Strait 52 ii0 = 139 ; ii1 = 141 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0. 53 ii0 = 142 ; ii1 = 142 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. / 90.54 ii0 = 143 ; ii1 = 143 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.40 55 ii0 = 144 ; ii1 = 144 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.75 61 ii0 = 139 ; ii1 = 141 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0._wp 62 ii0 = 142 ; ii1 = 142 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp 63 ii0 = 143 ; ii1 = 143 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp 64 ii0 = 144 ; ii1 = 144 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.75_wp 56 65 ! 57 66 ij0 = 87 ; ij1 = 96 ! Red Sea 58 ii0 = 147 ; ii1 = 163 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. 67 ii0 = 147 ; ii1 = 163 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp 59 68 ! 60 69 ij0 = 91 ; ij1 = 91 ! Decrease before Bab el Mandeb Strait 61 ii0 = 153 ; ii1 = 160 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.80 70 ii0 = 153 ; ii1 = 160 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.80_wp 62 71 ij0 = 90 ; ij1 = 90 63 ii0 = 153 ; ii1 = 160 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.40 72 ii0 = 153 ; ii1 = 160 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp 64 73 ij0 = 89 ; ij1 = 89 65 ii0 = 158 ; ii1 = 160 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. / 90.74 ii0 = 158 ; ii1 = 160 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp 66 75 ij0 = 88 ; ij1 = 88 67 ii0 = 160 ; ii1 = 163 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0. 76 ii0 = 160 ; ii1 = 163 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0._wp 68 77 ! 69 78 ! ! ======================= … … 71 80 ! ! ======================= 72 81 ii0 = 568 ; ii1 = 574 ! Mediterranean Sea 73 ij0 = 324 ; ij1 = 333 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. 82 ij0 = 324 ; ij1 = 333 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp 74 83 ii0 = 575 ; ii1 = 658 75 ij0 = 314 ; ij1 = 366 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. 84 ij0 = 314 ; ij1 = 366 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp 76 85 ! 77 86 ii0 = 641 ; ii1 = 651 ! Black Sea (remaining part 78 ij0 = 367 ; ij1 = 372 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. 87 ij0 = 367 ; ij1 = 372 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp 79 88 ! 80 89 ij0 = 324 ; ij1 = 333 ! Decrease before Gibraltar Strait 81 ii0 = 565 ; ii1 = 565 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. / 90.82 ii0 = 566 ; ii1 = 566 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.40 83 ii0 = 567 ; ii1 = 567 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.75 90 ii0 = 565 ; ii1 = 565 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp 91 ii0 = 566 ; ii1 = 566 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp 92 ii0 = 567 ; ii1 = 567 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.75_wp 84 93 ! 85 94 ii0 = 641 ; ii1 = 665 ! Red Sea 86 ij0 = 270 ; ij1 = 310 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. 95 ij0 = 270 ; ij1 = 310 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp 87 96 ! 88 97 ii0 = 666 ; ii1 = 675 ! Decrease before Bab el Mandeb Strait 89 98 ij0 = 270 ; ij1 = 290 90 99 DO ji = ii0, ii1 91 zmrs( ji , ij0:ij1 ) = 0.1 * ABS( FLOAT(ji - ii1) )100 zmrs( ji , ij0:ij1 ) = 0.1_wp * ABS( FLOAT(ji - ii1) ) 92 101 END DO 93 102 ! ! ======================== … … 100 109 END SELECT 101 110 102 ! Note that the original "online" code had a dependency on model levels 103 ! here (as opposed to depth) 104 ! This has been removed but can be reproduced using the "custom" module 105 ! if required 106 zsdmp = 1. / ( pn_surf * rday ) 107 zbdmp = 1. / ( pn_bot * rday ) 108 zhfac = ( zbdmp + (zsdmp-zbdmp) * EXP( -gdept(1,1)/pn_dep ) ) 111 zsdmp = 1._wp / ( pn_surf * rday ) 112 zbdmp = 1._wp / ( pn_bot * rday ) 109 113 110 presto(:,:) = zmrs(:,:) * zhfac + ( 1. - zmrs(:,:) ) * presto(:,:) 114 ! The l_31_lev option is used to reproduce the old behaviour of 115 ! defining the restoration coefficient based on the level number. 116 ! This is included to allow damping coefficients for reference 117 ! configurations to be kept the same. 118 IF (l_31_lev) THEN 119 IF (jk <= 17) THEN 120 zhfac = 0.5_wp * ( 1. - COS( rpi * REAL(jk-1,wp) / 16._wp ) ) / rday 121 ELSE 122 zhfac = 1._wp / rday 123 ENDIF 124 ELSE 125 zhfac = ( zbdmp + (zsdmp-zbdmp) * EXP( -gdept(1,1)/pn_dep ) ) 126 ENDIF 127 128 presto(:,:) = zmrs(:,:) * zhfac + ( 1._wp - zmrs(:,:) ) * presto(:,:) 111 129 112 130 DEALLOCATE( zmrs )
Note: See TracChangeset
for help on using the changeset viewer.