[4738] | 1 | PROGRAM 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 |
---|
[10722] | 34 | LOGICAL :: ln_distcoast_calc ! logical for calculating the distance |
---|
| 35 | ! to coast on the first depth. |
---|
| 36 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zdct! distance to coast field |
---|
[4738] | 37 | |
---|
| 38 | ! Read namelist |
---|
| 39 | OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' ) |
---|
| 40 | READ( numnam, nam_dmp_create ) |
---|
| 41 | CLOSE( numnam ) |
---|
| 42 | |
---|
| 43 | IF ( ln_full_field .AND. lzoom ) THEN |
---|
| 44 | WRITE(numerr,*) 'Only one of ln_full_field and lzoom can be .true.' |
---|
| 45 | STOP |
---|
| 46 | ENDIF |
---|
| 47 | |
---|
| 48 | CALL grid_info(meshfile) |
---|
| 49 | WRITE(numout, *) 'jpi = ',jpi |
---|
| 50 | WRITE(numout, *) 'jpj = ',jpj |
---|
| 51 | WRITE(numout, *) 'jpk = ',jpk |
---|
| 52 | |
---|
[10722] | 53 | ln_distcoast_calc=.true. |
---|
| 54 | |
---|
[4738] | 55 | ALLOCATE( resto(jpi, jpj) ) |
---|
[10722] | 56 | ALLOCATE( zdct(jpi, jpj) ) |
---|
[4738] | 57 | |
---|
| 58 | !Create output file |
---|
| 59 | CALL make_outfile( outfile ) |
---|
| 60 | |
---|
| 61 | CALL check_nf90( nf90_get_var( ncin, gphit_id, gphit, (/ 1,1 /), (/ jpi, jpj /) ) ) |
---|
| 62 | |
---|
| 63 | !Calculate surface and bottom damping coefficients |
---|
[4739] | 64 | zsdmp = 1._wp / ( pn_surf * rday ) |
---|
| 65 | zbdmp = 1._wp / ( pn_bot * rday ) |
---|
[4738] | 66 | |
---|
| 67 | !Loop through levels and read in tmask for each level as starting point for |
---|
| 68 | !coefficient array |
---|
| 69 | DO jk = 1, jpk-1 |
---|
[4739] | 70 | resto(:,:) = 0._wp |
---|
[4738] | 71 | |
---|
| 72 | IF (.NOT. (jk == 1 .AND. ln_zero_top_layer) ) THEN |
---|
| 73 | !Read in tmask depth for this level |
---|
| 74 | CALL check_nf90( nf90_get_var( ncin, tmask_id, tmask, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) ) |
---|
| 75 | CALL check_nf90( nf90_get_var( ncin, gdept_id, gdept, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) ) |
---|
| 76 | |
---|
| 77 | |
---|
| 78 | IF ( ln_full_field ) THEN |
---|
| 79 | !Set basic value of resto |
---|
| 80 | DO jj = 1, jpj |
---|
| 81 | DO ji = 1, jpi |
---|
| 82 | resto(ji,jj) = tmask(ji, jj) * (zbdmp + (zsdmp-zbdmp) * EXP(-gdept(ji,jj)/pn_dep)) |
---|
| 83 | END DO |
---|
| 84 | END DO |
---|
| 85 | IF ((nn_hdmp > 0)) THEN |
---|
| 86 | zlat0 = 10. !width of latitude strip where resto decreases |
---|
| 87 | zlat2 = nn_hdmp + zlat0 |
---|
| 88 | DO jj = 1, jpj |
---|
| 89 | DO ji = 1, jpi |
---|
| 90 | zlat = ABS(gphit(ji,jj)) |
---|
| 91 | IF ( nn_hdmp <= zlat .AND. zlat <= zlat2 ) THEN |
---|
[4739] | 92 | resto(ji,jj) = resto(ji,jj) * 0.5_wp * ( 1._wp - COS( rpi*(zlat-nn_hdmp)/zlat0 ) ) |
---|
[4738] | 93 | ELSE IF ( zlat < nn_hdmp ) THEN |
---|
[4739] | 94 | resto(ji,jj) = 0._wp |
---|
[4738] | 95 | ENDIF |
---|
| 96 | END DO |
---|
| 97 | END DO |
---|
| 98 | ENDIF |
---|
| 99 | |
---|
| 100 | IF (ln_coast) THEN |
---|
| 101 | ! Reduce damping in vicinity of coastlines |
---|
[10722] | 102 | CALL coast_dist_weight(resto, zdct, ln_readdistcoast, jk, ln_distcoast_calc) |
---|
[4738] | 103 | ENDIF |
---|
| 104 | ENDIF |
---|
| 105 | |
---|
| 106 | ! Damping in Med/Red Seas (or local modifications if full field is set) |
---|
[4739] | 107 | IF (ln_med_red_seas .AND. (cp_cfg == 'orca') .AND. (.NOT. lzoom)) THEN |
---|
| 108 | CALL med_red_dmp(resto, jk, ln_old_31_lev_code) |
---|
[4738] | 109 | ENDIF |
---|
| 110 | |
---|
| 111 | IF ( lzoom ) THEN |
---|
| 112 | CALL dtacof_zoom(resto, tmask) |
---|
| 113 | ENDIF |
---|
[4739] | 114 | |
---|
| 115 | !Any user modifications can be added in the custom module |
---|
| 116 | IF ( ln_custom ) THEN |
---|
| 117 | CALL custom_resto( resto ) |
---|
| 118 | ENDIF |
---|
[4738] | 119 | ENDIF |
---|
| 120 | |
---|
| 121 | ! Write out resto for this level |
---|
| 122 | CALL check_nf90( nf90_put_var( ncout, resto_id, resto, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) ) |
---|
| 123 | |
---|
| 124 | END DO |
---|
| 125 | |
---|
| 126 | ! Close the output file |
---|
| 127 | CALL check_nf90( nf90_close(ncout) ) |
---|
| 128 | |
---|
| 129 | END PROGRAM make_dmp_file |
---|