Changeset 11692 for NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/OCE/DIA/diadct.F90
- Timestamp:
- 2019-10-12T16:08:18+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/OCE/DIA/diadct.F90
r10425 r11692 11 11 !! 3.4 ! 09/2011 (C Bricaud) 12 12 !!---------------------------------------------------------------------- 13 #if defined key_diadct 14 !!---------------------------------------------------------------------- 15 !! 'key_diadct' : 16 !!---------------------------------------------------------------------- 13 !! does not work with agrif 14 #if ! defined key_agrif 17 15 !!---------------------------------------------------------------------- 18 16 !! dia_dct : Compute the transport through a sec. … … 42 40 43 41 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 42 PUBLIC dia_dct_init ! routine called by nemogcm.F90 43 44 ! !!** namelist variables ** 45 LOGICAL, PUBLIC :: ln_diadct !: Calculate transport thru a section or not 46 INTEGER :: nn_dct ! Frequency of computation 47 INTEGER :: nn_dctwri ! Frequency of output 48 INTEGER :: nn_secdebug ! Number of the section to debug 56 49 57 50 INTEGER, PARAMETER :: nb_class_max = 10 … … 104 97 CONTAINS 105 98 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 99 INTEGER FUNCTION diadct_alloc() 100 !!---------------------------------------------------------------------- 101 !! *** FUNCTION diadct_alloc *** 102 !!---------------------------------------------------------------------- 103 104 ALLOCATE( transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk), & 105 & transports_2d(nb_2d_vars,nb_sec_max,nb_point_max) , STAT=diadct_alloc ) 106 107 CALL mpp_sum( 'diadct', diadct_alloc ) 108 IF( diadct_alloc /= 0 ) CALL ctl_stop( 'STOP', 'diadct_alloc: failed to allocate arrays' ) 109 110 END FUNCTION diadct_alloc 121 111 122 112 SUBROUTINE dia_dct_init … … 130 120 INTEGER :: ios ! Local integer output status for namelist read 131 121 !! 132 NAMELIST/nam dct/nn_dct,nn_dctwri,nn_secdebug122 NAMELIST/nam_diadct/ln_diadct, nn_dct, nn_dctwri, nn_secdebug 133 123 !!--------------------------------------------------------------------- 134 124 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', lwp)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', lwp)142 IF(lwm) WRITE ( numond, nam dct )125 REWIND( numnam_ref ) ! Namelist nam_diadct in reference namelist : Diagnostic: transport through sections 126 READ ( numnam_ref, nam_diadct, IOSTAT = ios, ERR = 901) 127 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diadct in reference namelist' ) 128 129 REWIND( numnam_cfg ) ! Namelist nam_diadct in configuration namelist : Diagnostic: transport through sections 130 READ ( numnam_cfg, nam_diadct, IOSTAT = ios, ERR = 902 ) 131 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nam_diadct in configuration namelist' ) 132 IF(lwm) WRITE ( numond, nam_diadct ) 143 133 144 134 IF( lwp ) THEN … … 146 136 WRITE(numout,*) "diadct_init: compute transports through sections " 147 137 WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~" 148 WRITE(numout,*) " Frequency of computation: nn_dct = ",nn_dct 149 WRITE(numout,*) " Frequency of write: nn_dctwri = ",nn_dctwri 138 WRITE(numout,*) " Calculate transport thru sections: ln_diadct = ", ln_diadct 139 WRITE(numout,*) " Frequency of computation: nn_dct = ", nn_dct 140 WRITE(numout,*) " Frequency of write: nn_dctwri = ", nn_dctwri 150 141 151 142 IF ( nn_secdebug .GE. 1 .AND. nn_secdebug .LE. nb_sec_max )THEN … … 155 146 ELSE ; WRITE(numout,*)" Wrong value for nn_secdebug : ",nn_secdebug 156 147 ENDIF 157 148 ENDIF 149 150 IF( ln_diadct ) THEN 151 ! control 158 152 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 153 & CALL ctl_stop( 'diadct: nn_dct should be smaller and a multiple of nn_dctwri' ) 154 155 ! allocate dia_dct arrays 156 IF( diadct_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'diadct_alloc: failed to allocate arrays' ) 157 158 !Read section_ijglobal.diadct 159 CALL readsec 160 161 !open output file 162 IF( lwm ) THEN 163 CALL ctl_opn( numdct_vol, 'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 164 CALL ctl_opn( numdct_heat, 'heat_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 165 CALL ctl_opn( numdct_salt, 'salt_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 166 ENDIF 167 168 ! Initialise arrays to zero 169 transports_3d(:,:,:,:)=0.0 170 transports_2d(:,:,:) =0.0 171 ! 161 172 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 173 ! 177 174 END SUBROUTINE dia_dct_init … … 1241 1238 #else 1242 1239 !!---------------------------------------------------------------------- 1243 !! D efault option : Dummy module1240 !! Dummy module 1244 1241 !!---------------------------------------------------------------------- 1245 LOGICAL, PUBLIC, PARAMETER :: lk_diadct = .FALSE. !: diamht flag 1246 PUBLIC 1247 !! $Id$ 1242 LOGICAL, PUBLIC :: ln_diadct = .FALSE. 1248 1243 CONTAINS 1249 1250 SUBROUTINE dia_dct_init ! Dummy routine 1244 SUBROUTINE dia_dct_init 1251 1245 IMPLICIT NONE 1252 WRITE(*,*) 'dia_dct_init: You should not have seen this print! error?'1253 1246 END SUBROUTINE dia_dct_init 1254 1255 SUBROUTINE dia_dct( kt ) ! Dummy routine 1247 SUBROUTINE dia_dct( kt ) 1256 1248 IMPLICIT NONE 1257 INTEGER, INTENT( in ) :: kt ! ocean time-step index 1258 WRITE(*,*) 'dia_dct: You should not have seen this print! error?', kt 1249 INTEGER, INTENT(in) :: kt 1259 1250 END SUBROUTINE dia_dct 1251 ! 1260 1252 #endif 1261 1253
Note: See TracChangeset
for help on using the changeset viewer.