Changeset 11381 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/DIA/diadct.F90
- Timestamp:
- 2019-07-31T16:44:56+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/DIA/diadct.F90
r11380 r11381 11 11 !! 3.4 ! 09/2011 (C Bricaud) 12 12 !!---------------------------------------------------------------------- 13 #if defined key_diadct 14 !!---------------------------------------------------------------------- 15 !! 'key_diadct' : 16 !!---------------------------------------------------------------------- 13 !! 17 14 !!---------------------------------------------------------------------- 18 15 !! dia_dct : Compute the transport through a sec. … … 42 39 43 40 PUBLIC dia_dct ! routine called by step.F90 44 PUBLIC dia_dct_init ! routine called by opa.F90 45 PUBLIC diadct_alloc ! routine called by nemo_init in nemogcm.F90 46 PRIVATE readsec 47 PRIVATE removepoints 48 PRIVATE transport 49 PRIVATE dia_dct_wri 50 51 LOGICAL, PUBLIC, PARAMETER :: lk_diadct = .TRUE. !: model-data diagnostics flag 52 53 INTEGER :: nn_dct ! Frequency of computation 54 INTEGER :: nn_dctwri ! Frequency of output 55 INTEGER :: nn_secdebug ! Number of the section to debug 41 PUBLIC dia_dct_init ! routine called by nemogcm.F90 42 43 ! !!** namelist variables ** 44 LOGICAL, PUBLIC :: ln_diadct ! Calculate transport thru a section or not 45 INTEGER :: nn_dct ! Frequency of computation 46 INTEGER :: nn_dctwri ! Frequency of output 47 INTEGER :: nn_secdebug ! Number of the section to debug 56 48 57 49 INTEGER, PARAMETER :: nb_class_max = 10 … … 104 96 CONTAINS 105 97 106 INTEGER FUNCTION diadct_alloc() 107 !!---------------------------------------------------------------------- 108 !! *** FUNCTION diadct_alloc *** 109 !!---------------------------------------------------------------------- 110 INTEGER :: ierr(2) 111 !!---------------------------------------------------------------------- 112 113 ALLOCATE(transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk), STAT=ierr(1) ) 114 ALLOCATE(transports_2d(nb_2d_vars,nb_sec_max,nb_point_max) , STAT=ierr(2) ) 115 116 diadct_alloc = MAXVAL( ierr ) 117 IF( diadct_alloc /= 0 ) CALL ctl_stop( 'STOP', 'diadct_alloc: failed to allocate arrays' ) 118 119 END FUNCTION diadct_alloc 120 98 INTEGER FUNCTION diadct_alloc() 99 !!---------------------------------------------------------------------- 100 !! *** FUNCTION diadct_alloc *** 101 !!---------------------------------------------------------------------- 102 103 ALLOCATE( transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk), & 104 & transports_2d(nb_2d_vars,nb_sec_max,nb_point_max) , STAT=diadct_alloc ) 105 106 CALL mpp_sum( 'diadct', diadct_alloc ) 107 IF( diadct_alloc /= 0 ) CALL ctl_stop( 'STOP', 'diadct_alloc: failed to allocate arrays' ) 108 109 END FUNCTION diadct_alloc 121 110 122 111 SUBROUTINE dia_dct_init … … 130 119 INTEGER :: ios ! Local integer output status for namelist read 131 120 !! 132 NAMELIST/nam dct/nn_dct,nn_dctwri,nn_secdebug121 NAMELIST/nam_diadct/ln_diadct, nn_dct, nn_dctwri, nn_secdebug 133 122 !!--------------------------------------------------------------------- 134 123 135 REWIND( numnam_ref ) ! Namelist nam dct in reference namelist : Diagnostic: transport through sections136 READ ( numnam_ref, nam dct, IOSTAT = ios, ERR = 901)137 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam dct in reference namelist' )138 139 REWIND( numnam_cfg ) ! Namelist nam dct in configuration namelist : Diagnostic: transport through sections140 READ ( numnam_cfg, nam dct, IOSTAT = ios, ERR = 902 )141 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nam dct in configuration namelist' )142 IF(lwm) WRITE ( numond, nam dct )124 REWIND( numnam_ref ) ! Namelist nam_diadct in reference namelist : Diagnostic: transport through sections 125 READ ( numnam_ref, nam_diadct, IOSTAT = ios, ERR = 901) 126 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diadct in reference namelist' ) 127 128 REWIND( numnam_cfg ) ! Namelist nam_diadct in configuration namelist : Diagnostic: transport through sections 129 READ ( numnam_cfg, nam_diadct, IOSTAT = ios, ERR = 902 ) 130 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nam_diadct in configuration namelist' ) 131 IF(lwm) WRITE ( numond, nam_diadct ) 143 132 144 133 IF( lwp ) THEN … … 146 135 WRITE(numout,*) "diadct_init: compute transports through sections " 147 136 WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~" 148 WRITE(numout,*) " Frequency of computation: nn_dct = ",nn_dct 149 WRITE(numout,*) " Frequency of write: nn_dctwri = ",nn_dctwri 137 WRITE(numout,*) " Calculate transport thru sections: ln_diadct = ", ln_diadct 138 WRITE(numout,*) " Frequency of computation: nn_dct = ", nn_dct 139 WRITE(numout,*) " Frequency of write: nn_dctwri = ", nn_dctwri 150 140 151 141 IF ( nn_secdebug .GE. 1 .AND. nn_secdebug .LE. nb_sec_max )THEN … … 155 145 ELSE ; WRITE(numout,*)" Wrong value for nn_secdebug : ",nn_secdebug 156 146 ENDIF 157 147 ENDIF 148 149 IF( ln_diadct ) THEN 150 ! control 158 151 IF(nn_dct .GE. nn_dctwri .AND. MOD(nn_dct,nn_dctwri) .NE. 0) & 159 & CALL ctl_stop( 'diadct: nn_dct should be smaller and a multiple of nn_dctwri' ) 160 152 & CALL ctl_stop( 'diadct: nn_dct should be smaller and a multiple of nn_dctwri' ) 153 154 ! allocate dia_dct arrays 155 IF( diadct_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'diadct_alloc: failed to allocate arrays' ) 156 157 !Read section_ijglobal.diadct 158 CALL readsec 159 160 !open output file 161 IF( lwm ) THEN 162 CALL ctl_opn( numdct_vol, 'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 163 CALL ctl_opn( numdct_heat, 'heat_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 164 CALL ctl_opn( numdct_salt, 'salt_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 165 ENDIF 166 167 ! Initialise arrays to zero 168 transports_3d(:,:,:,:)=0.0 169 transports_2d(:,:,:) =0.0 170 ! 161 171 ENDIF 162 163 !Read section_ijglobal.diadct164 CALL readsec165 166 !open output file167 IF( lwm ) THEN168 CALL ctl_opn( numdct_vol, 'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )169 CALL ctl_opn( numdct_heat, 'heat_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )170 CALL ctl_opn( numdct_salt, 'salt_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )171 ENDIF172 173 ! Initialise arrays to zero174 transports_3d(:,:,:,:)=0.0175 transports_2d(:,:,:) =0.0176 172 ! 177 173 END SUBROUTINE dia_dct_init … … 1239 1235 END FUNCTION interp 1240 1236 1241 #else1242 !!----------------------------------------------------------------------1243 !! Default option : Dummy module1244 !!----------------------------------------------------------------------1245 LOGICAL, PUBLIC, PARAMETER :: lk_diadct = .FALSE. !: diamht flag1246 PUBLIC1247 !! $Id$1248 CONTAINS1249 1250 SUBROUTINE dia_dct_init ! Dummy routine1251 IMPLICIT NONE1252 WRITE(*,*) 'dia_dct_init: You should not have seen this print! error?'1253 END SUBROUTINE dia_dct_init1254 1255 SUBROUTINE dia_dct( kt ) ! Dummy routine1256 IMPLICIT NONE1257 INTEGER, INTENT( in ) :: kt ! ocean time-step index1258 WRITE(*,*) 'dia_dct: You should not have seen this print! error?', kt1259 END SUBROUTINE dia_dct1260 #endif1261 1262 1237 !!====================================================================== 1263 1238 END MODULE diadct
Note: See TracChangeset
for help on using the changeset viewer.