source: branches/UKMO/dev_r5518_DMP_TOOLS/NEMOGCM/TOOLS/DMP_TOOLS/src/med_red_seas.F90 @ 10778

Last change on this file since 10778 was 4739, checked in by timgraham, 6 years ago

Updated C1D/dyndmp.F90 and trcdmp.F90 to read restoration coefficient from a file.
Modified namelist_top_ref to match new options
Bug fixes to DMP_TOOLS tool and addition of custom.F90 to allow users to make modifications. Also changed to use working precision (wp) throughout.

File size: 6.0 KB
Line 
1MODULE med_red_seas
2
3   USE utils
4   
5   IMPLICIT NONE
6   PUBLIC
7
8   CONTAINS 
9
10   SUBROUTINE med_red_dmp(presto, jk, ln_31_lev)
11      !!------------------------------------
12      !!    **ROUTINE: med_red_dmp
13      !!
14      !! **Purpose: Apply specific modifications to damping coefficients on ORCA
15      !!            grids in Med and Red Seas
16      !!
17      !!-----------------------------------
18      INTEGER :: ij0,ij1,ii0,ii1,ji,jj     
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
25
26      WRITE(numout,*) 'ORCA Med and Red Seas Damping'
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     
34      ALLOCATE( zmrs(jpi, jpj) )
35         !
36         zmrs(:,:) = 0._wp
37         !
38         SELECT CASE ( jp_cfg )
39         !                                           ! =======================
40         CASE ( 4 )                                  !  ORCA_R4 configuration
41            !                                        ! =======================
42            ij0 =  50   ;   ij1 =  56                    ! Mediterranean Sea
43
44            ii0 =  81   ;   ii1 =  91   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1.
45            ij0 =  50   ;   ij1 =  55
46            ii0 =  75   ;   ii1 =  80   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1.
47            ij0 =  52   ;   ij1 =  53
48            ii0 =  70   ;   ii1 =  74   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1.
49           !
50           !                                        ! =======================
51         CASE ( 2 )                                  !  ORCA_R2 configuration
52            !                                        ! =======================
53            ij0 =  96   ;   ij1 = 110                    ! Mediterranean Sea
54            ii0 = 157   ;   ii1 = 181   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
55            ij0 = 100   ;   ij1 = 110
56            ii0 = 144   ;   ii1 = 156   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
57            ij0 = 100   ;   ij1 = 103
58            ii0 = 139   ;   ii1 = 143   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
59            !
60            ij0 = 101   ;   ij1 = 102                    ! Decrease before Gibraltar Strait
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
65            !
66            ij0 =  87   ;   ij1 =  96                    ! Red Sea
67            ii0 = 147   ;   ii1 = 163   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
68            !
69            ij0 =  91   ;   ij1 =  91                    ! Decrease before Bab el Mandeb Strait
70            ii0 = 153   ;   ii1 = 160   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.80_wp
71            ij0 =  90   ;   ij1 =  90
72            ii0 = 153   ;   ii1 = 160   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp
73            ij0 =  89   ;   ij1 =  89
74            ii0 = 158   ;   ii1 = 160   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp
75            ij0 =  88   ;   ij1 =  88
76            ii0 = 160   ;   ii1 = 163   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0._wp
77            !
78            !                                        ! =======================
79         CASE ( 05 )                                 !  ORCA_R05 configuration
80            !                                        ! =======================
81            ii0 = 568   ;   ii1 = 574                    ! Mediterranean Sea
82            ij0 = 324   ;   ij1 = 333   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
83            ii0 = 575   ;   ii1 = 658
84            ij0 = 314   ;   ij1 = 366   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
85            !
86            ii0 = 641   ;   ii1 = 651                    ! Black Sea (remaining part
87            ij0 = 367   ;   ij1 = 372   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
88            !
89            ij0 = 324   ;   ij1 = 333                    ! Decrease before Gibraltar Strait
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
93            !
94            ii0 = 641   ;   ii1 = 665                    ! Red Sea
95            ij0 = 270   ;   ij1 = 310   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
96            !
97            ii0 = 666   ;   ii1 = 675                    ! Decrease before Bab el Mandeb Strait
98            ij0 = 270   ;   ij1 = 290   
99            DO ji = ii0, ii1
100               zmrs( ji , ij0:ij1 ) = 0.1_wp * ABS( FLOAT(ji - ii1) )
101            END DO 
102            !                                       ! ========================
103         CASE ( 025 )                               !  ORCA_R025 configuration
104            !                                       ! ========================
105            WRITE(numerr,*) ' Mediterranean and Red Sea damping option not implemented for ORCA_R025'
106            WRITE(numerr,*) ' Set ln_med_red = .false.'
107            STOP
108            !
109         END SELECT
110
111         zsdmp = 1._wp / ( pn_surf * rday )
112         zbdmp = 1._wp / ( pn_bot  * rday )
113
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(:,:)
129
130         DEALLOCATE( zmrs )         
131
132   END SUBROUTINE med_red_dmp
133
134
135END MODULE med_red_seas
Note: See TracBrowser for help on using the repository browser.