Changeset 1450 for trunk/NEMO
- Timestamp:
- 2009-05-15T16:12:12+02:00 (15 years ago)
- Location:
- trunk/NEMO
- Files:
-
- 5 edited
-
OFF_SRC/IOM/iom.F90 (modified) (10 diffs)
-
OFF_SRC/IOM/iom_def.F90 (modified) (1 diff)
-
OFF_SRC/daymod.F90 (modified) (4 diffs)
-
OFF_SRC/opa.F90 (modified) (7 diffs)
-
TOP_SRC/trcdia.F90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OFF_SRC/IOM/iom.F90
r1324 r1450 26 26 USE iom_rstdimg ! restarts access direct format "dimg" style... 27 27 28 #if defined key_iomput 29 USE mod_event_client 30 # endif 31 28 32 IMPLICIT NONE 29 33 PUBLIC ! must be public to be able to access iom_def through iom 30 34 31 PUBLIC iom_ open, iom_close, iom_varid, iom_get, iom_gettime, iom_rstput35 PUBLIC iom_init, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 32 36 33 37 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 34 38 PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d 39 PRIVATE iom_p2d, iom_p3d 40 #if defined key_iomput 41 PRIVATE iom_init_chkcpp 42 PRIVATE set_grid 43 # endif 35 44 36 45 INTERFACE iom_get … … 40 49 MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 41 50 END INTERFACE 51 INTERFACE iom_put 52 MODULE PROCEDURE iom_p2d, iom_p3d 53 END INTERFACE 54 #if defined key_iomput 55 INTERFACE iom_setkt 56 MODULE PROCEDURE event__set_timestep 57 END INTERFACE 58 # endif 42 59 43 60 !!---------------------------------------------------------------------- … … 49 66 CONTAINS 50 67 51 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop ) 68 SUBROUTINE iom_init( pjulian ) 69 !!---------------------------------------------------------------------- 70 !! *** ROUTINE *** 71 !! 72 !! ** Purpose : 73 !! 74 !!---------------------------------------------------------------------- 75 REAL(wp), INTENT(in) :: pjulian !: julian day at nit000 = 0 76 #if defined key_iomput 77 !!---------------------------------------------------------------------- 78 ! read the xml file 79 CALL event__parse_xml_file( 'iodef.xml' ) ! <- to get from the nameliste (namrun)... 80 81 ! calendar parameters 82 CALL event__set_time_parameters( nit000 - 1, pjulian, rdt ) 83 84 ! horizontal grid definition 85 CALL set_grid( "grid_T", glamt, gphit ) 86 CALL set_grid( "grid_U", glamu, gphiu ) 87 CALL set_grid( "grid_V", glamv, gphiv ) 88 CALL set_grid( "grid_W", glamt, gphit ) 89 90 ! vertical grid definition 91 CALL event__set_vert_axis( "deptht", gdept_0 ) 92 CALL event__set_vert_axis( "depthu", gdept_0 ) 93 CALL event__set_vert_axis( "depthv", gdept_0 ) 94 CALL event__set_vert_axis( "depthw", gdepw_0 ) 95 96 ! consistency regarding CPP keys... 97 CALL iom_init_chkcpp 98 99 ! end file definition 100 CALL event__close_io_definition 101 #endif 102 103 END SUBROUTINE iom_init 104 105 106 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof ) 52 107 !!--------------------------------------------------------------------- 53 108 !! *** SUBROUTINE iom_open *** … … 61 116 INTEGER , INTENT(in ), OPTIONAL :: kiolib ! library used to open the file (default = jpnf90) 62 117 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 118 LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 63 119 64 120 CHARACTER(LEN=100) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] … … 71 127 LOGICAL :: llnoov ! local definition to read overlap 72 128 LOGICAL :: llstop ! local definition of ldstop 129 LOGICAL :: lliof ! local definition of ldiof 73 130 INTEGER :: iolib ! library do we use to open the file 74 131 INTEGER :: icnt ! counter for digits in clcpu (max = jpmax_digits) … … 85 142 ! Initializations and control 86 143 ! ============= 144 kiomid = -1 87 145 clinfo = ' iom_open ~~~ ' 88 146 istop = nstop 89 147 ! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0 90 148 ! (could be done when defining iom_file in f95 but not in f90) 91 IF( iom_init == 0 ) THEN 149 #if ! defined key_agrif 150 IF( iom_open_init == 0 ) THEN 92 151 iom_file(:)%nfid = 0 93 iom_init = 1 94 ENDIF 152 iom_open_init = 1 153 ENDIF 154 #else 155 IF( Agrif_Root() ) THEN 156 IF( iom_open_init == 0 ) THEN 157 iom_file(:)%nfid = 0 158 iom_open_init = 1 159 ENDIF 160 ENDIF 161 #endif 95 162 ! do we read or write the file? 96 163 IF( PRESENT(ldwrt) ) THEN ; llwrt = ldwrt … … 105 172 ELSE ; iolib = jpnf90 106 173 ENDIF 174 ! are we using interpolation on the fly? 175 IF( PRESENT(ldiof) ) THEN ; lliof = ldiof 176 ELSE ; lliof = .FALSE. 177 ENDIF 107 178 ! do we read the overlap 108 179 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 109 #if ! defined key_agrif 110 llnoov = (jpni * jpnj ) == jpnij 111 #endif 180 llnoov = (jpni * jpnj ) == jpnij 112 181 ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix) 113 182 ! ============= 114 183 clname = trim(cdname) 115 184 #if defined key_agrif 116 IF ( .NOT. Agrif_Root() ) THEN185 IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN 117 186 iln = INDEX(clname,'/') 118 187 cltmpn = clname(1:iln) … … 239 308 i_s = 1 240 309 i_e = jpmax_files 310 #if defined key_iomput 311 CALL event__stop_ioserver 312 #endif 241 313 ENDIF 242 314 … … 451 523 ! do we read the overlap 452 524 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 453 #if ! defined key_agrif 454 llnoov = (jpni * jpnj ) == jpnij 455 #endif 525 llnoov = (jpni * jpnj ) == jpnij 456 526 ! check kcount and kstart optionals parameters... 457 527 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') … … 819 889 ENDIF 820 890 END SUBROUTINE iom_rp3d 891 892 821 893 !!---------------------------------------------------------------------- 894 !! INTERFACE iom_rstput 895 !!---------------------------------------------------------------------- 896 SUBROUTINE iom_p2d( cdname, pfield2d ) 897 CHARACTER(LEN=*) , INTENT(in) :: cdname 898 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfield2d 899 #if defined key_iomput 900 CALL event__write_field2D( cdname, pfield2d(nldi:nlei, nldj:nlej) ) 901 #endif 902 END SUBROUTINE iom_p2d 903 904 SUBROUTINE iom_p3d( cdname, pfield3d ) 905 CHARACTER(LEN=*) , INTENT(in) :: cdname 906 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pfield3d 907 #if defined key_iomput 908 CALL event__write_field3D( cdname, pfield3d(nldi:nlei, nldj:nlej, :) ) 909 #endif 910 END SUBROUTINE iom_p3d 911 !!---------------------------------------------------------------------- 912 913 914 #if defined key_iomput 915 916 SUBROUTINE set_grid( cdname, plon, plat ) 917 !!---------------------------------------------------------------------- 918 !! *** ROUTINE *** 919 !! 920 !! ** Purpose : 921 !! 922 !!---------------------------------------------------------------------- 923 CHARACTER(LEN=*) , INTENT(in) :: cdname 924 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon 925 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 926 927 CALL event__set_grid_dimension( cdname, jpiglo, jpjglo) 928 CALL event__set_grid_domain( cdname, nlei-nldi+1, nlej-nldj+1, nimpp+nldi-1, njmpp+nldj-1, & 929 & plon(nldi:nlei, nldj:nlej), plat(nldi:nlei, nldj:nlej) ) 930 CALL event__set_grid_type_nemo( cdname ) 931 932 END SUBROUTINE set_grid 933 934 935 SUBROUTINE iom_init_chkcpp 936 !!--------------------------------------------------------------------- 937 !! *** SUBROUTINE *** 938 !! 939 !! ** Purpose : 940 !!--------------------------------------------------------------------- 941 USE zdfddm, ONLY : lk_zdfddm ! vertical physics: double diffusion 942 943 #if ! defined key_off_tra 944 #if defined key_dynspg_rl 945 CALL event__disable_field( "sossheig" ) 946 #else 947 CALL event__disable_field( "sobarstf" ) 948 #endif 949 950 !!#if ! ( ! defined key_dynspg_rl && defined key_ice_lim) 951 !! CALL disable_field( "iowaflup" ) 952 !! CALL disable_field( "sowaflep" ) 953 !!#endif 954 955 #if ! defined key_coupled 956 CALL event__enable_field( "sohefldp" ) 957 CALL event__enable_field( "sowafldp" ) 958 CALL event__enable_field( "sosafldp" ) 959 #endif 960 961 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 ) 962 CALL event__enable_field( "sohefldp" ) 963 CALL event__enable_field( "sowafldp" ) 964 CALL event__enable_field( "sosafldp" ) 965 #endif 966 967 #if ! defined key_diaspr 968 CALL event__disable_field( "sosurfps" ) 969 #endif 970 971 #if ! defined key_diahth 972 CALL event__disable_field( "sothedep" ) 973 CALL event__disable_field( "so20chgt" ) 974 CALL event__disable_field( "so28chgt" ) 975 CALL event__disable_field( "sohtc300" ) 976 #endif 977 978 #if defined key_coupled 979 # if defined key_lim3 980 Must be adapted to LIM3 981 # else 982 CALL event__enable_field( "soicetem" ) 983 CALL event__enable_field( "soicealb" ) 984 # endif 985 #endif 986 987 #if ! defined key_diaeiv 988 CALL event__disable_field( "vozoeivu" ) 989 CALL event__disable_field( "vomeeivv" ) 990 CALL event__disable_field( "voveeivw" ) 991 #endif 992 993 #if ! defined key_dynspg_rl 994 CALL event__disable_field( "sozospgx" ) 995 CALL event__disable_field( "somespgy" ) 996 #endif 997 998 IF( lk_zdfddm ) CALL event__enable_field( "voddmavs" ) 999 1000 #if ! defined key_traldf_c2d 1001 CALL event__disable_field( "soleahtw" ) 1002 #endif 1003 1004 #if ! defined key_traldf_eiv 1005 CALL event__disable_field( "soleaeiw" ) 1006 #endif 1007 #endif 1008 1009 END SUBROUTINE iom_init_chkcpp 1010 1011 #else 1012 1013 SUBROUTINE iom_setkt( kt ) 1014 INTEGER, INTENT(in ):: kt 1015 END SUBROUTINE iom_setkt 1016 1017 #endif 822 1018 823 1019 -
trunk/NEMO/OFF_SRC/IOM/iom_def.F90
r1324 r1450 49 49 50 50 !$AGRIF_DO_NOT_TREAT 51 INTEGER, PUBLIC :: iom_ init = 0!: used to initialize iom_file(:)%nfid to 051 INTEGER, PUBLIC :: iom_open_init = 0 !: used to initialize iom_file(:)%nfid to 0 52 52 53 53 TYPE, PUBLIC :: file_descriptor -
trunk/NEMO/OFF_SRC/daymod.F90
r1291 r1450 30 30 USE in_out_manager ! I/O manager 31 31 USE prtctl ! Print control 32 USE ioipsl, ONLY : ymds2ju ! for calendar 32 33 33 34 IMPLICIT NONE … … 46 47 REAL(wp), PUBLIC :: rsec_day !: current time step counted in second since 00h of the current day 47 48 49 REAL(wp), PUBLIC :: fjulday !: julian day 48 50 REAL(wp), PUBLIC :: adatrj !: number of elapsed days since the begining of the run 49 51 ! !: it is the accumulated duration of previous runs … … 95 97 nmonth = ( ndastp - (nyear * 10000) ) / 100 96 98 nday = ndastp - (nyear * 10000) - ( nmonth * 100 ) 99 100 CALL ymds2ju( nyear, nmonth, nday, 0.0, fjulday ) ! we assume that we start run at 00:00 101 fjulday = fjulday + 1. ! move back to the day at nit000 (and not at nit000 - 1) 102 97 103 98 104 sec1jan000 = 0.e0 … … 203 209 rsec_day = rsec_day + rdttra(1) 204 210 adatrj = adatrj + rdttra(1) / rday 205 211 fjulday = fjulday + rdttra(1) / rday 212 206 213 IF( rsec_day > rday ) THEN ! NEW day 207 214 ! -
trunk/NEMO/OFF_SRC/opa.F90
r1350 r1450 29 29 USE trcini ! Initilization of the passive tracers 30 30 USE step ! OPA time-stepping (stp routine) 31 32 USE iom 33 #if defined key_iomput 34 USE mod_ioclient 35 #endif 31 36 32 37 IMPLICIT NONE … … 130 135 !!---------------------------------------------------------------------- 131 136 !! * Local declarations 137 #if defined key_iomput 138 INTEGER :: localComm 139 #endif 132 140 CHARACTER (len=20) :: namelistname 133 141 CHARACTER (len=28) :: file_out 142 NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle, & 143 & isplt , jsplt , njctls, njctle, nbench 134 144 135 145 !!---------------------------------------------------------------------- … … 156 166 WRITE(numout,*) 157 167 168 ! Namelist namctl : Control prints & Benchmark 169 REWIND( numnam ) 170 READ ( numnam, namctl ) 171 172 #if defined key_iomput 173 CALL init_ioclient(localcomm) 174 narea = mynode(localComm) 175 #else 158 176 ! Nodes selection 159 177 narea = mynode() 178 #endif 179 180 ! Nodes selection 160 181 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) 161 182 lwp = narea == 1 … … 180 201 ENDIF 181 202 203 CALL opa_flg ! Control prints & Benchmark 204 182 205 ! ! ============================== ! 183 206 ! ! Model general initialization ! … … 212 235 CALL ldf_tra_init ! Lateral ocean tracer physics 213 236 #endif 237 CALL iom_init( fjulday - adatrj ) ! iom_put initialization 214 238 ! ! =============== ! 215 239 ! ! time stepping ! … … 220 244 END SUBROUTINE opa_init 221 245 246 SUBROUTINE opa_flg 247 !!---------------------------------------------------------------------- 248 !! *** ROUTINE opa *** 249 !! 250 !! ** Purpose : Initialize logical flags that control the choice of 251 !! some algorithm or control print 252 !! 253 !! ** Method : Read in namilist namflg logical flags 254 !! 255 !! History : 256 !! 9.0 ! 03-11 (G. Madec) Original code 257 !!---------------------------------------------------------------------- 258 !! * Local declarations 259 260 ! Parameter control and print 261 ! --------------------------- 262 IF(lwp) THEN 263 WRITE(numout,*) 264 WRITE(numout,*) 'opa_flg: Control prints & Benchmark' 265 WRITE(numout,*) '~~~~~~~ ' 266 WRITE(numout,*) ' Namelist namctl' 267 WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl 268 WRITE(numout,*) ' level of print nprint = ', nprint 269 WRITE(numout,*) ' Start i indice for SUM control nictls = ', nictls 270 WRITE(numout,*) ' End i indice for SUM control nictle = ', nictle 271 WRITE(numout,*) ' Start j indice for SUM control njctls = ', njctls 272 WRITE(numout,*) ' End j indice for SUM control njctle = ', njctle 273 WRITE(numout,*) ' number of proc. following i isplt = ', isplt 274 WRITE(numout,*) ' number of proc. following j jsplt = ', jsplt 275 WRITE(numout,*) ' benchmark parameter (0/1) nbench = ', nbench 276 ENDIF 277 278 ! ... Control the sub-domain area indices for the control prints 279 IF( ln_ctl ) THEN 280 IF( lk_mpp ) THEN 281 ! the domain is forced to the real splitted domain in MPI 282 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj 283 ELSE 284 IF( isplt == 1 .AND. jsplt == 1 ) THEN 285 CALL ctl_warn( ' - isplt & jsplt are equal to 1', & 286 & ' - the print control will be done over the whole domain' ) 287 ENDIF 288 289 ! compute the total number of processors ijsplt 290 ijsplt = isplt*jsplt 291 ENDIF 292 293 IF(lwp) WRITE(numout,*)' - The total number of processors over which the' 294 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt 295 296 ! Control the indices used for the SUM control 297 IF( nictls+nictle+njctls+njctle == 0 ) THEN 298 ! the print control is done over the default area 299 lsp_area = .FALSE. 300 ELSE 301 ! the print control is done over a specific area 302 lsp_area = .TRUE. 303 IF( nictls < 1 .OR. nictls > jpiglo ) THEN 304 CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 305 nictls = 1 306 ENDIF 307 308 IF( nictle < 1 .OR. nictle > jpiglo ) THEN 309 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 310 nictle = jpiglo 311 ENDIF 312 313 IF( njctls < 1 .OR. njctls > jpjglo ) THEN 314 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 315 njctls = 1 316 ENDIF 317 318 IF( njctle < 1 .OR. njctle > jpjglo ) THEN 319 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 320 njctle = jpjglo 321 ENDIF 322 323 ENDIF ! IF( nictls+nictle+njctls+njctle == 0 ) 324 ENDIF ! IF(ln_ctl) 325 326 IF( nbench == 1 ) THEN 327 SELECT CASE ( cp_cfg ) 328 CASE ( 'gyre' ) 329 CALL ctl_warn( ' The Benchmark is activated ' ) 330 CASE DEFAULT 331 CALL ctl_stop( ' The Benchmark is based on the GYRE configuration: key_gyre must & 332 & be used or set nbench = 0' ) 333 END SELECT 334 ENDIF 335 336 END SUBROUTINE opa_flg 337 222 338 SUBROUTINE opa_closefile 223 339 !!---------------------------------------------------------------------- … … 243 359 IF(lwp) CLOSE( numstp ) ! time-step file 244 360 361 CALL iom_close ! close all input/output files 362 245 363 END SUBROUTINE opa_closefile 246 364 -
trunk/NEMO/TOP_SRC/trcdia.F90
r1391 r1450 29 29 USE lib_mpp 30 30 USE ioipsl 31 USE iom 31 32 32 33 IMPLICIT NONE … … 117 118 ! -------------- 118 119 120 CALL iom_setkt( kt + ndttrc - 1 ) 121 119 122 ! local variable for debugging 120 123 ll_print = .FALSE. ! change it to true for more control print … … 207 210 208 211 DO jn = 1, jptra 209 IF( lutsav(jn) ) THEN 210 cltra = ctrcnm(jn) ! short title for tracer 211 CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 ) 212 ENDIF 212 cltra = ctrcnm(jn) ! short title for tracer 213 IF( lutsav(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 ) 214 CALL iom_put( ctrcnm(jn), trn(:,:,:,jn) ) 213 215 END DO 214 216 … … 217 219 IF( kt == nitend .OR. kindic < 0 ) CALL histclo( nit5 ) 218 220 ! 221 CALL iom_setkt( kt ) 222 219 223 END SUBROUTINE trcdit_wr 220 224 … … 252 256 ! 0. Initialisation 253 257 ! ----------------- 258 259 CALL iom_setkt( kt + ndttrc - 1 ) 254 260 255 261 ! local variable for debugging … … 439 445 END DO 440 446 END IF 447 CALL iom_put( ctrcnm(jn), trn(:,:,:,jn) ) 441 448 END DO 442 449 … … 449 456 ENDIF 450 457 ! 458 CALL iom_setkt( kt ) 459 451 460 END SUBROUTINE trcdid_wr 452 461 … … 484 493 CHARACTER (len=20) :: cltra, cltrau 485 494 CHARACTER (len=80) :: cltral 486 INTEGER :: j n495 INTEGER :: jl 487 496 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod 488 497 REAL(wp) :: zsto, zout, zdt … … 491 500 ! Initialisation 492 501 ! -------------- 493 502 503 CALL iom_setkt( kt + ndttrc - 1 ) 504 494 505 ! local variable for debugging 495 506 ll_print = .FALSE. … … 546 557 547 558 ! more 3D horizontal arrays 548 DO j n= 1, jpdia3d549 cltra = ctrc3d(j n) ! short title for 3D diagnostic550 cltral = ctrc3l(j n) ! long title for 3D diagnostic551 cltrau = ctrc3u(j n) ! UNIT for 3D diagnostic559 DO jl = 1, jpdia3d 560 cltra = ctrc3d(jl) ! short title for 3D diagnostic 561 cltral = ctrc3l(jl) ! long title for 3D diagnostic 562 cltrau = ctrc3u(jl) ! UNIT for 3D diagnostic 552 563 CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd, & 553 564 & ipk, 1, ipk, ndepitd, 32, clop, zsto, zout ) … … 555 566 556 567 ! more 2D horizontal arrays 557 DO j n= 1, jpdia2d558 cltra = ctrc2d(j n) ! short title for 2D diagnostic559 cltral = ctrc2l(j n) ! long title for 2D diagnostic560 cltrau = ctrc2u(j n) ! UNIT for 2D diagnostic568 DO jl = 1, jpdia2d 569 cltra = ctrc2d(jl) ! short title for 2D diagnostic 570 cltral = ctrc2l(jl) ! long title for 2D diagnostic 571 cltrau = ctrc2u(jl) ! UNIT for 2D diagnostic 561 572 CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd, & 562 573 & 1, 1, 1, -99, 32, clop, zsto, zout ) … … 583 594 584 595 ! more 3D horizontal arrays 585 DO jn = 1, jpdia3d 586 cltra = ctrc3d(jn) ! short title for 3D diagnostic 587 CALL histwrite( nitd, cltra, it, trc3d(:,:,:,jn), ndimt50 ,ndext50) 596 DO jl = 1, jpdia3d 597 cltra = ctrc3d(jl) ! short title for 3D diagnostic 598 CALL histwrite( nitd, cltra, it, trc3d(:,:,:,jl), ndimt50 ,ndext50) 599 CALL iom_put( cltra, trc3d(:,:,:,jl) ) 588 600 END DO 589 601 590 602 ! more 2D horizontal arrays 591 DO jn = 1, jpdia2d 592 cltra = ctrc2d(jn) ! short title for 2D diagnostic 593 CALL histwrite(nitd, cltra, it, trc2d(:,:,jn), ndimt51 ,ndext51) 603 DO jl = 1, jpdia2d 604 cltra = ctrc2d(jl) ! short title for 2D diagnostic 605 CALL histwrite(nitd, cltra, it, trc2d(:,:,jl), ndimt51 ,ndext51) 606 CALL iom_put( cltra, trc2d(:,:,jl) ) 594 607 END DO 595 608 … … 598 611 IF( kt == nitend .OR. kindic < 0 ) CALL histclo(nitd) 599 612 ! 613 CALL iom_setkt( kt ) 614 600 615 END SUBROUTINE trcdii_wr 601 616 … … 634 649 CHARACTER (len=20) :: cltra, cltrau 635 650 CHARACTER (len=80) :: cltral 636 INTEGER :: ji, jj, jk, j n651 INTEGER :: ji, jj, jk, jl 637 652 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod 638 653 REAL(wp) :: zsto, zout, zdt … … 642 657 ! -------------- 643 658 659 CALL iom_setkt( kt + ndttrc - 1 ) 660 644 661 ! local variable for debugging 645 662 ll_print = .FALSE. … … 689 706 ! Declare all the output fields as NETCDF variables 690 707 ! biological trends 691 DO j n= 1, jpdiabio692 cltra = ctrbio(j n) ! short title for biological diagnostic693 cltral = ctrbil(j n) ! long title for biological diagnostic694 cltrau = ctrbiu(j n) ! UNIT for biological diagnostic708 DO jl = 1, jpdiabio 709 cltra = ctrbio(jl) ! short title for biological diagnostic 710 cltral = ctrbil(jl) ! long title for biological diagnostic 711 cltrau = ctrbiu(jl) ! UNIT for biological diagnostic 695 712 CALL histdef( nitb, cltra, cltral, cltrau, jpi, jpj, nhoritb, & 696 713 & ipk, 1, ipk, ndepitb, 32, clop, zsto, zout) … … 715 732 ENDIF 716 733 717 DO jn = 1, jpdiabio 718 cltra = ctrbio(jn) ! short title for biological diagnostic 719 CALL histwrite(nitb, cltra, it, trbio(:,:,:,jn), ndimt50,ndext50) 734 DO jl = 1, jpdiabio 735 cltra = ctrbio(jl) ! short title for biological diagnostic 736 CALL histwrite(nitb, cltra, it, trbio(:,:,:,jl), ndimt50,ndext50) 737 CALL iom_put( cltra, trbio(:,:,:,jl) ) 720 738 END DO 721 739 … … 724 742 IF( kt == nitend .OR. kindic < 0 ) CALL histclo( nitb ) 725 743 ! 744 CALL iom_setkt( kt ) 745 726 746 END SUBROUTINE trcdib_wr 727 747
Note: See TracChangeset
for help on using the changeset viewer.
