[1252] | 1 | MODULE trclsm_c14b |
---|
| 2 | !!====================================================================== |
---|
| 3 | !! *** MODULE trclsm_c14b *** |
---|
| 4 | !! TOP : initialisation of some run parameters for C14 chemical model |
---|
| 5 | !!====================================================================== |
---|
| 6 | !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) from trclsm.cfc.h90 |
---|
| 7 | !!---------------------------------------------------------------------- |
---|
| 8 | #if defined key_c14b |
---|
| 9 | !!---------------------------------------------------------------------- |
---|
| 10 | !! 'key_c14b' C14 bomb tracer |
---|
| 11 | !!---------------------------------------------------------------------- |
---|
| 12 | !! trc_lsm_c14b : C14 model initialisation |
---|
| 13 | !!---------------------------------------------------------------------- |
---|
| 14 | USE oce_trc ! Ocean variables |
---|
| 15 | USE par_trc ! TOP parameters |
---|
| 16 | USE trc ! TOP variables |
---|
| 17 | USE trcsms_c14b ! C14b specific variable |
---|
[1581] | 18 | USE in_out_manager ! I/O manager |
---|
[1252] | 19 | |
---|
| 20 | IMPLICIT NONE |
---|
| 21 | PRIVATE |
---|
| 22 | |
---|
| 23 | PUBLIC trc_lsm_c14b ! called by trclsm.F90 module |
---|
| 24 | |
---|
| 25 | !!---------------------------------------------------------------------- |
---|
| 26 | !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) |
---|
| 27 | !! $Id: trclsm_cfc.F90 1146 2008-06-25 11:42:56Z rblod $ |
---|
| 28 | !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) |
---|
| 29 | !!---------------------------------------------------------------------- |
---|
| 30 | |
---|
| 31 | CONTAINS |
---|
| 32 | |
---|
| 33 | SUBROUTINE trc_lsm_c14b |
---|
| 34 | !!------------------------------------------------------------------- |
---|
| 35 | !! *** ROUTINE trc_lsm_c14b *** |
---|
| 36 | !! |
---|
| 37 | !! ** Purpose : Definition some run parameter for C14 model |
---|
| 38 | !! |
---|
| 39 | !! ** Method : Read the namc14 namelist and check the parameter |
---|
| 40 | !! values called at the first timestep (nit000) |
---|
| 41 | !! |
---|
| 42 | !! ** input : Namelist namelist_c14b |
---|
| 43 | !!---------------------------------------------------------------------- |
---|
| 44 | INTEGER :: numnatb |
---|
| 45 | |
---|
[1801] | 46 | #if defined key_trc_diaadd && ! defined key_iomput |
---|
[1252] | 47 | ! definition of additional diagnostic as a structure |
---|
| 48 | INTEGER :: jl, jn |
---|
| 49 | TYPE DIAG |
---|
| 50 | CHARACTER(len = 20) :: snamedia !: short name |
---|
| 51 | CHARACTER(len = 80 ) :: lnamedia !: long name |
---|
| 52 | CHARACTER(len = 20 ) :: unitdia !: unit |
---|
| 53 | END TYPE DIAG |
---|
| 54 | |
---|
| 55 | TYPE(DIAG) , DIMENSION(jp_c14b_2d) :: c14dia2d |
---|
| 56 | TYPE(DIAG) , DIMENSION(jp_c14b_3d) :: c14dia3d |
---|
| 57 | #endif |
---|
| 58 | !! |
---|
| 59 | NAMELIST/namc14date/ ndate_beg_b, nyear_res_b |
---|
[1801] | 60 | #if defined key_trc_diaadd && ! defined key_iomput |
---|
[1252] | 61 | NAMELIST/namc14dia/nwritedia, c14dia2d, c14dia3d ! additional diagnostics |
---|
| 62 | #endif |
---|
| 63 | !!------------------------------------------------------------------- |
---|
| 64 | |
---|
| 65 | ndate_beg_b = 650101 ! default namelist value |
---|
| 66 | nyear_res_b = 1955 |
---|
| 67 | |
---|
| 68 | ! ! Open namelist file |
---|
[1581] | 69 | CALL ctl_opn( numnatb, 'namelist_c14b', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) |
---|
[1252] | 70 | |
---|
| 71 | READ( numnatb , namc14date ) ! read namelist |
---|
| 72 | |
---|
| 73 | IF(lwp) THEN ! control print |
---|
| 74 | WRITE(numout,*) |
---|
| 75 | WRITE(numout,*) ' trc_lsm: Read namdates, namelist for C14 chemical model' |
---|
| 76 | WRITE(numout,*) ' ~~~~~~~' |
---|
| 77 | WRITE(numout,*) ' initial calendar date (aammjj) for C14 ndate_beg_b = ', ndate_beg_b |
---|
| 78 | WRITE(numout,*) ' restoring time constant (year) nyear_res_b = ', nyear_res_b |
---|
| 79 | ENDIF |
---|
| 80 | nyear_beg_b = ndate_beg_b / 10000 |
---|
| 81 | IF(lwp) WRITE(numout,*) ' initial year (aa) nyear_beg_b = ', nyear_beg_b |
---|
| 82 | ! |
---|
[1801] | 83 | #if defined key_trc_diaadd && ! defined key_iomput |
---|
[1252] | 84 | |
---|
| 85 | ! Namelist namc14dia |
---|
| 86 | ! ------------------- |
---|
| 87 | nwritedia = 10 ! default values |
---|
| 88 | |
---|
| 89 | DO jl = 1, jp_c14b_2d |
---|
| 90 | jn = jp_c14b0_2d + jl - 1 |
---|
| 91 | WRITE(ctrc2d(jn),'("2D_",I1)') jn ! short name |
---|
| 92 | WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn ! long name |
---|
| 93 | ctrc2u(jn) = ' ' ! units |
---|
| 94 | END DO |
---|
| 95 | ! ! 3D output arrays |
---|
| 96 | DO jl = 1, jp_c14b_3d |
---|
| 97 | jn = jp_c14b0_3d + jl - 1 |
---|
| 98 | WRITE(ctrc3d(jn),'("3D_",I1)') jn ! short name |
---|
| 99 | WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn ! long name |
---|
| 100 | ctrc3u(jn) = ' ' ! units |
---|
| 101 | END DO |
---|
| 102 | |
---|
| 103 | REWIND( numnatb ) ! read natrtd |
---|
| 104 | READ ( numnatb, namc14dia ) |
---|
| 105 | |
---|
| 106 | DO jl = 1, jp_c14b_2d |
---|
| 107 | jn = jp_c14b0_2d + jl - 1 |
---|
| 108 | ctrc2d(jn) = c14dia2d(jl)%snamedia |
---|
| 109 | ctrc2l(jn) = c14dia2d(jl)%lnamedia |
---|
| 110 | ctrc2u(jn) = c14dia2d(jl)%unitdia |
---|
| 111 | END DO |
---|
| 112 | |
---|
| 113 | DO jl = 1, jp_c14b_3d |
---|
| 114 | jn = jp_c14b0_3d + jl - 1 |
---|
| 115 | ctrc3d(jn) = c14dia3d(jl)%snamedia |
---|
| 116 | ctrc3l(jn) = c14dia3d(jl)%lnamedia |
---|
| 117 | ctrc3u(jn) = c14dia3d(jl)%unitdia |
---|
| 118 | END DO |
---|
| 119 | |
---|
| 120 | IF(lwp) THEN ! control print |
---|
| 121 | WRITE(numout,*) |
---|
| 122 | WRITE(numout,*) ' Namelist : natadd' |
---|
| 123 | WRITE(numout,*) ' frequency of outputs for additional arrays nwritedia = ', nwritedia |
---|
| 124 | DO jl = 1, jp_c14b_3d |
---|
| 125 | jn = jp_c14b0_3d + jl - 1 |
---|
| 126 | WRITE(numout,*) ' 3d output field No : ',jn |
---|
| 127 | WRITE(numout,*) ' short name : ', TRIM(ctrc3d(jn)) |
---|
| 128 | WRITE(numout,*) ' long name : ', TRIM(ctrc3l(jn)) |
---|
| 129 | WRITE(numout,*) ' unit : ', TRIM(ctrc3u(jn)) |
---|
| 130 | WRITE(numout,*) ' ' |
---|
| 131 | END DO |
---|
| 132 | |
---|
| 133 | DO jl = 1, jp_c14b_2d |
---|
| 134 | jn = jp_c14b0_2d + jl - 1 |
---|
| 135 | WRITE(numout,*) ' 2d output field No : ',jn |
---|
| 136 | WRITE(numout,*) ' short name : ', TRIM(ctrc2d(jn)) |
---|
| 137 | WRITE(numout,*) ' long name : ', TRIM(ctrc2l(jn)) |
---|
| 138 | WRITE(numout,*) ' unit : ', TRIM(ctrc2u(jn)) |
---|
| 139 | WRITE(numout,*) ' ' |
---|
| 140 | END DO |
---|
| 141 | ENDIF |
---|
| 142 | |
---|
| 143 | #endif |
---|
| 144 | |
---|
| 145 | END SUBROUTINE trc_lsm_c14b |
---|
| 146 | |
---|
| 147 | #else |
---|
| 148 | !!---------------------------------------------------------------------- |
---|
| 149 | !! Dummy module : No 14C |
---|
| 150 | !!---------------------------------------------------------------------- |
---|
| 151 | CONTAINS |
---|
| 152 | SUBROUTINE trc_lsm_c14b ! Empty routine |
---|
| 153 | END SUBROUTINE trc_lsm_c14b |
---|
| 154 | #endif |
---|
| 155 | |
---|
| 156 | !!====================================================================== |
---|
| 157 | END MODULE trclsm_c14b |
---|