New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 4739 for branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/src/med_red_seas.F90 – NEMO

Ignore:
Timestamp:
2014-08-13T10:46:04+02:00 (10 years ago)
Author:
timgraham
Message:

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:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/src/med_red_seas.F90

    r4738 r4739  
    88   CONTAINS   
    99 
    10    SUBROUTINE med_red_dmp(presto) 
     10   SUBROUTINE med_red_dmp(presto, jk, ln_31_lev) 
    1111      !!------------------------------------ 
    1212      !!    **ROUTINE: med_red_dmp 
    … …  
    1717      !!----------------------------------- 
    1818      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 
    2225 
    2326      WRITE(numout,*) 'ORCA Med and Red Seas Damping' 
    2427       
     28      IF ( PRESENT(ln_31_lev)) THEN 
     29         l_31_lev = ln_31_lev 
     30      ELSE 
     31         l_31_lev = .false. 
     32      ENDIF 
     33       
    2534      ALLOCATE( zmrs(jpi, jpj) ) 
    2635         ! 
    27          zmrs(:,:) = 0. 
     36         zmrs(:,:) = 0._wp 
    2837         ! 
    2938         SELECT CASE ( jp_cfg ) 
    … …  
    4352            !                                        ! ======================= 
    4453            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 
    4655            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 
    4857            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 
    5059            ! 
    5160            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 
    5665            ! 
    5766            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 
    5968            ! 
    6069            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 
    6271            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 
    6473            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 
    6675            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 
    6877            ! 
    6978            !                                        ! ======================= 
    … …  
    7180            !                                        ! ======================= 
    7281            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 
    7483            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 
    7685            ! 
    7786            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 
    7988            ! 
    8089            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 
    8493            ! 
    8594            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 
    8796            ! 
    8897            ii0 = 666   ;   ii1 = 675                    ! Decrease before Bab el Mandeb Strait 
    8998            ij0 = 270   ;   ij1 = 290    
    9099            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) ) 
    92101            END DO  
    93102            !                                       ! ======================== 
    … …  
    100109         END SELECT 
    101110 
    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 ) 
    109113 
    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(:,:) 
    111129 
    112130         DEALLOCATE( zmrs )          
Note: See TracChangeset for help on using the changeset viewer.