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.
make_dmp_file.F90 in branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/src – NEMO

source: branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/src/make_dmp_file.F90 @ 5102

Last change on this file since 5102 was 4745, checked in by timgraham, 10 years ago

Modified documentation to describe new features.

File size: 4.3 KB
RevLine 
[4738]1PROGRAM make_dmp_file
2  !================================================================================
3  !               *** PROGRAM make_dmp_file ****
4  !================================================================================
5  !
6  !  Purpose: Create a file containing a spacially varying
7  !           restoration coefficient to be used by TRADMP
8  !
9  !  Method:  1) Read in tmask from mesh_mask file to use as a template
[4745]10  !           2) Calculate restoration coefficients according to options
11  !           specified in the namelist. The user may modify custom.F90 to
12  !           specify specific damping options e.g. to mask certain regions only).
[4738]13  !           3) Write the array to output file
14  !
15  !  History: Original code: Tim Graham (Jul 2014) - some code moved from
16  !                            old tradmp.F90 module to this tool (as part of NEMO
17  !                            simplification process).
18  !-------------------------------------------------------------------------------
19
20  ! Declare variables
21  USE netcdf 
22  USE utils
23  USE coastdist
24  USE med_red_seas
25  USE zoom
[4739]26  USE custom
[4738]27
28  IMPLICIT NONE
29  INTEGER  :: ji, jj, jk                         ! dummpy loop variables
[4739]30  REAL(wp) :: zsdmp, zbdmp                     ! Surface and bottom damping coeff
[4738]31  CHARACTER(LEN=200) :: meshfile = 'mesh_mask.nc'   ! mesh file
[4739]32  CHARACTER(LEN=200) :: outfile = 'resto.nc'     ! output file
33  REAL(wp) :: zlat, zlat2, zlat0
[4738]34
35  ! Read namelist
36  OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' )
37  READ( numnam, nam_dmp_create )
38  CLOSE( numnam )
39 
40  IF ( ln_full_field .AND. lzoom ) THEN
41    WRITE(numerr,*) 'Only one of ln_full_field and lzoom can be .true.'
42    STOP
43  ENDIF
44
45  CALL grid_info(meshfile)
46  WRITE(numout, *) 'jpi = ',jpi
47  WRITE(numout, *) 'jpj = ',jpj
48  WRITE(numout, *) 'jpk = ',jpk
49
50  ALLOCATE( resto(jpi, jpj) )
51
52  !Create output file
53  CALL make_outfile( outfile )
54 
55  CALL check_nf90( nf90_get_var( ncin, gphit_id, gphit, (/ 1,1 /), (/ jpi, jpj /) ) )
56
57  !Calculate surface and bottom damping coefficients
[4739]58  zsdmp = 1._wp / ( pn_surf * rday )
59  zbdmp = 1._wp / ( pn_bot  * rday )
[4738]60
61  !Loop through levels and read in tmask for each level as starting point for
62  !coefficient array
63  DO jk = 1, jpk-1
[4739]64     resto(:,:) = 0._wp
[4738]65     
66     IF (.NOT. (jk == 1 .AND. ln_zero_top_layer) ) THEN 
67        !Read in tmask depth for this level
68        CALL check_nf90( nf90_get_var( ncin, tmask_id, tmask, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
69        CALL check_nf90( nf90_get_var( ncin, gdept_id, gdept, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
70     
71
72        IF ( ln_full_field ) THEN
73           !Set basic value of resto
74           DO jj = 1, jpj
75              DO ji = 1, jpi
76                 resto(ji,jj) = tmask(ji, jj) * (zbdmp + (zsdmp-zbdmp) * EXP(-gdept(ji,jj)/pn_dep))
77              END DO
78           END DO
79           IF ((nn_hdmp > 0)) THEN
80              zlat0 = 10. !width of latitude strip where resto decreases
81              zlat2 = nn_hdmp + zlat0
82              DO jj = 1, jpj
83                 DO ji = 1, jpi
84                    zlat = ABS(gphit(ji,jj))
85                    IF ( nn_hdmp <= zlat .AND. zlat <= zlat2 ) THEN
[4739]86                       resto(ji,jj) = resto(ji,jj) * 0.5_wp * (  1._wp - COS( rpi*(zlat-nn_hdmp)/zlat0 ) )
[4738]87                    ELSE IF ( zlat < nn_hdmp ) THEN
[4739]88                       resto(ji,jj) = 0._wp
[4738]89                    ENDIF
90                 END DO
91              END DO
92           ENDIF
93   
94           IF (ln_coast) THEN
95              ! Reduce damping in vicinity of coastlines
96              CALL coast_dist_weight(resto)
97           ENDIF
98        ENDIF
99
100        ! Damping in Med/Red Seas (or local modifications if full field is set)
[4739]101        IF (ln_med_red_seas .AND. (cp_cfg == 'orca') .AND. (.NOT. lzoom)) THEN
102           CALL med_red_dmp(resto, jk, ln_old_31_lev_code)
[4738]103        ENDIF
104
105        IF ( lzoom ) THEN
106              CALL dtacof_zoom(resto, tmask)
107        ENDIF
[4739]108       
109        !Any user modifications can be added in the custom module
110        IF ( ln_custom ) THEN
111              CALL custom_resto( resto )
112        ENDIF
[4738]113     ENDIF
114
115     ! Write out resto for this level
116     CALL check_nf90( nf90_put_var( ncout, resto_id, resto, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
117
118  END DO
119 
120  ! Close the output file
121  CALL check_nf90( nf90_close(ncout) )
122
123END PROGRAM make_dmp_file
Note: See TracBrowser for help on using the repository browser.