Changeset 9194 for branches/UKMO/AMM15_v3_6_STABLE_package_withNOOS/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
- Timestamp:
- 2018-01-09T11:25:08+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/AMM15_v3_6_STABLE_package_withNOOS/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r8058 r9194 59 59 PRIVATE transport 60 60 PRIVATE dia_dct_wri 61 PRIVATE dia_dct_wri_NOOS 61 62 62 63 #include "domzgr_substitute.h90" … … 66 67 67 68 !! * Module variables 68 INTEGER :: nn_dct ! Frequency of computation 69 INTEGER :: nn_dctwri ! Frequency of output 70 INTEGER :: nn_secdebug ! Number of the section to debug 69 INTEGER :: nn_dct = 1 ! Frequency of computation 70 INTEGER :: nn_dctwri = 1 ! Frequency of output 71 INTEGER :: nn_secdebug = 0 ! Number of the section to debug 72 INTEGER :: nn_dct_h = 1 ! Frequency of computation for NOOS hourly files 73 INTEGER :: nn_dctwri_h = 1 ! Frequency of output for NOOS hourly files 71 74 72 INTEGER, PARAMETER :: nb_class_max = 1 073 INTEGER, PARAMETER :: nb_sec_max = 15074 INTEGER, PARAMETER :: nb_point_max = 200075 INTEGER, PARAMETER :: nb_type_class = 1076 INTEGER, PARAMETER :: nb_3d_vars = 377 INTEGER, PARAMETER :: nb_2d_vars = 2 75 INTEGER, PARAMETER :: nb_class_max = 12 ! maximum number of classes, i.e. depth levels or density classes 76 INTEGER, PARAMETER :: nb_sec_max = 30 ! maximum number of sections 77 INTEGER, PARAMETER :: nb_point_max = 300 ! maximum number of points in a single section 78 INTEGER, PARAMETER :: nb_type_class = 14 ! types of calculations, i.e. pos transport, neg transport, heat transport, salt transport 79 INTEGER, PARAMETER :: nb_3d_vars = 5 80 INTEGER, PARAMETER :: nb_2d_vars = 2 78 81 INTEGER :: nb_sec 79 82 … … 102 105 zlay ! level classes (99 if you don't want) 103 106 REAL(wp), DIMENSION(nb_type_class,nb_class_max) :: transport ! transport output 107 REAL(wp), DIMENSION(nb_type_class,nb_class_max) :: transport_h ! transport output 104 108 REAL(wp) :: slopeSection ! slope of the section 105 109 INTEGER :: nb_point ! number of points in the section … … 111 115 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: transports_3d 112 116 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: transports_2d 117 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: transports_3d_h 118 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: transports_2d_h 119 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_hr_output 113 120 114 121 !! $Id$ … … 120 127 !! *** FUNCTION diadct_alloc *** 121 128 !!---------------------------------------------------------------------- 122 INTEGER :: ierr( 2)129 INTEGER :: ierr(5) 123 130 !!---------------------------------------------------------------------- 124 131 125 ALLOCATE(transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk), STAT=ierr(1) ) 126 ALLOCATE(transports_2d(nb_2d_vars,nb_sec_max,nb_point_max) , STAT=ierr(2) ) 132 ALLOCATE(transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk) , STAT=ierr(1) ) 133 ALLOCATE(transports_2d(nb_2d_vars,nb_sec_max,nb_point_max) , STAT=ierr(2) ) 134 ALLOCATE(transports_3d_h(nb_3d_vars,nb_sec_max,nb_point_max,jpk), STAT=ierr(3) ) 135 ALLOCATE(transports_2d_h(nb_2d_vars,nb_sec_max,nb_point_max) , STAT=ierr(4) ) 136 ALLOCATE(z_hr_output(nb_sec_max,168,nb_class_max) , STAT=ierr(5) ) ! 168 = 24 * 7days 127 137 128 138 diadct_alloc = MAXVAL( ierr ) … … 153 163 IF(lwm) WRITE ( numond, namdct ) 154 164 165 IF( ln_NOOS ) THEN 166 nn_dct=3600./rdt ! hard coded for NOOS transects, to give 25 hour means 167 nn_dctwri=86400./rdt 168 nn_dct_h=1 ! hard coded for NOOS transects, to give hourly data 169 nn_dctwri_h=3600./rdt 170 ENDIF 171 155 172 IF( lwp ) THEN 156 173 WRITE(numout,*) " " 157 174 WRITE(numout,*) "diadct_init: compute transports through sections " 158 175 WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~" 159 WRITE(numout,*) " Frequency of computation: nn_dct = ",nn_dct 160 WRITE(numout,*) " Frequency of write: nn_dctwri = ",nn_dctwri 176 IF( ln_NOOS ) THEN 177 WRITE(numout,*) " Frequency of computation hard coded to be every hour: nn_dct = ",nn_dct 178 WRITE(numout,*) " Frequency of write hard coded to average 25 instantaneous hour values: nn_dctwri = ",nn_dctwri 179 WRITE(numout,*) " Frequency of hourly computation hard coded to be every timestep: nn_dct_h = ",nn_dct_h 180 WRITE(numout,*) " Frequency of hourly write hard coded to every hour: nn_dctwri_h = ",nn_dctwri_h 181 ELSE 182 WRITE(numout,*) " Frequency of computation: nn_dct = ",nn_dct 183 WRITE(numout,*) " Frequency of write: nn_dctwri = ",nn_dctwri 184 ENDIF 161 185 162 186 IF ( nn_secdebug .GE. 1 .AND. nn_secdebug .LE. nb_sec_max )THEN … … 177 201 !open output file 178 202 IF( lwm ) THEN 179 CALL ctl_opn( numdct_vol, 'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 180 CALL ctl_opn( numdct_heat, 'heat_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 181 CALL ctl_opn( numdct_salt, 'salt_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 203 IF( ln_NOOS ) THEN 204 CALL ctl_opn( numdct_NOOS ,'NOOS_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 205 CALL ctl_opn( numdct_NOOS_h,'NOOS_transport_h', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 206 ELSE 207 CALL ctl_opn( numdct_vol, 'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 208 CALL ctl_opn( numdct_heat, 'heat_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 209 CALL ctl_opn( numdct_salt, 'salt_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 210 ENDIF 182 211 ENDIF 183 212 184 213 ! Initialise arrays to zero 185 transports_3d(:,:,:,:)=0.0 186 transports_2d(:,:,:) =0.0 214 transports_3d(:,:,:,:) =0.0 215 transports_2d(:,:,:) =0.0 216 transports_3d_h(:,:,:,:)=0._wp 217 transports_2d_h(:,:,:) =0._wp 218 z_hr_output(:,:,:) =0._wp 187 219 188 220 IF( nn_timing == 1 ) CALL timing_stop('dia_dct_init') … … 229 261 CALL wrk_alloc( nb_sec_max,nb_type_class,nb_class_max , zsum ) 230 262 ENDIF 231 263 lldebug=.TRUE. 232 264 ! Initialise arrays 233 265 zwork(:) = 0.0 … … 243 275 244 276 ! Compute transport and write only at nn_dctwri 245 IF( MOD(kt,nn_dct)==0 ) THEN 277 IF( MOD(kt,nn_dct)==0 .or. & ! compute transport every nn_dct time steps 278 (ln_NOOS .and. kt==nn_it000 ) ) THEN ! also include first time step when calculating NOOS 25 hour averages 246 279 247 280 DO jsec=1,nb_sec 248 281 249 282 !debug this section computing ? 250 lldebug=.FALSE.283 !lldebug=.FALSE. 251 284 IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. kt==nit000+nn_dct-1 .AND. lwp ) lldebug=.TRUE. 252 285 253 286 !Compute transport through section 254 287 CALL transport(secs(jsec),lldebug,jsec) 288 !WRITE(numout,*) 'Calling transport with lldebug override' 289 !CALL transport(secs(jsec),.TRUE.,jsec) 255 290 256 291 ENDDO … … 271 306 !Sum on all procs 272 307 IF( lk_mpp )THEN 308 zsum(:,:,:)=0.0_wp 273 309 ish(1) = nb_sec_max*nb_type_class*nb_class_max 274 310 ish2 = (/nb_sec_max,nb_type_class,nb_class_max/) … … 283 319 DO jsec=1,nb_sec 284 320 285 IF( lwm )CALL dia_dct_wri(kt,jsec,secs(jsec)) 321 IF( lwm .and. .not. ln_NOOS )CALL dia_dct_wri(kt,jsec,secs(jsec)) 322 IF( lwm .and. ln_NOOS )CALL dia_dct_wri_NOOS(kt,jsec,secs(jsec)) ! use NOOS specific formatting 286 323 287 324 !nullify transports values after writing 288 325 transports_3d(:,jsec,:,:)=0. 289 326 transports_2d(:,jsec,: )=0. 290 secs(jsec)%transport(:,:)=0. 327 secs(jsec)%transport(:,:)=0. 328 IF ( ln_NOOS ) CALL transport(secs(jsec),lldebug,jsec) ! reinitialise for next 25 hour instantaneous average (overlapping values) 291 329 292 330 ENDDO … … 295 333 296 334 ENDIF 335 336 IF ( MOD(kt,nn_dct_h)==0 ) THEN ! compute transport every nn_dct_h time steps 337 338 DO jsec=1,nb_sec 339 340 !lldebug=.FALSE. 341 IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. kt==nit000+nn_dct_h-1 .AND. lwp ) lldebug=.TRUE. 342 343 !Compute transport through section 344 CALL transport_h(secs(jsec),lldebug,jsec) 345 346 ENDDO 347 348 IF( MOD(kt,nn_dctwri_h)==0 )THEN 349 350 IF( lwp .AND. kt==nit000+nn_dctwri_h-1 )WRITE(numout,*)" diadct: average and write hourly files at kt = ",kt 351 352 !! divide arrays by nn_dctwri/nn_dct to obtain average 353 transports_3d_h(:,:,:,:)=transports_3d_h(:,:,:,:)/(nn_dctwri_h/nn_dct_h) 354 transports_2d_h(:,:,:) =transports_2d_h(:,:,:) /(nn_dctwri_h/nn_dct_h) 355 356 ! Sum over each class 357 DO jsec=1,nb_sec 358 CALL dia_dct_sum_h(secs(jsec),jsec) 359 ENDDO 360 361 !Sum on all procs 362 IF( lk_mpp )THEN 363 ish(1) = nb_sec_max*nb_type_class*nb_class_max 364 ish2 = (/nb_sec_max,nb_type_class,nb_class_max/) 365 DO jsec=1,nb_sec ; zsum(jsec,:,:) = secs(jsec)%transport_h(:,:) ; ENDDO 366 zwork(:)= RESHAPE(zsum(:,:,:), ish ) 367 CALL mpp_sum(zwork, ish(1)) 368 zsum(:,:,:)= RESHAPE(zwork,ish2) 369 DO jsec=1,nb_sec ; secs(jsec)%transport_h(:,:) = zsum(jsec,:,:) ; ENDDO 370 ENDIF 371 372 !Write the transport 373 DO jsec=1,nb_sec 374 375 IF( lwp .and. ln_NOOS )CALL dia_dct_wri_NOOS_h(kt/nn_dctwri_h,jsec,secs(jsec)) ! use NOOS specific formatting 376 377 !nullify transports values after writing 378 transports_3d_h(:,jsec,:,:)=0.0 379 transports_2d_h(:,jsec,:)=0.0 380 secs(jsec)%transport_h(:,:)=0. 381 IF ( ln_NOOS ) CALL transport_h(secs(jsec),lldebug,jsec) ! reinitialise for next 25 hour instantaneous average (overlapping values) 382 383 ENDDO 384 385 ENDIF 386 387 ENDIF 297 388 298 389 IF( lk_mpp )THEN … … 356 447 secs(jsec)%zlay = 99._wp 357 448 secs(jsec)%transport = 0._wp ; secs(jsec)%nb_point = 0 449 secs(jsec)%transport_h = 0._wp ; secs(jsec)%nb_point = 0 358 450 359 451 !read section's number / name / computing choices / classes / slopeSection / points number 360 452 !----------------------------------------------------------------------------------------- 361 453 READ(numdct_in,iostat=iost)isec 362 IF (iost .NE. 0 )EXIT !end of file 454 IF (iost .NE. 0 )EXIT !end of file 363 455 WRITE(cltmp,'(a,i4.4,a,i4.4)')'diadct: read sections : Problem of section number: isec= ',isec,' and jsec= ',jsec 364 IF( jsec .NE. isec ) 456 IF( jsec .NE. isec )CALL ctl_stop( cltmp ) 365 457 366 458 IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) )WRITE(numout,*)"isec ",isec … … 380 472 READ(numdct_in)iptglo 381 473 474 IF ( ln_NOOS ) THEN 475 WRITE(numout,*) 'Section name = ',TRIM(secs(jsec)%name) 476 WRITE(numout,*) 'coordSec = ',secs(jsec)%coordSec 477 WRITE(numout,*) 'iptglo = ',iptglo 478 ENDIF 479 382 480 !debug 383 481 !----- … … 405 503 !read points'coordinates and directions 406 504 !-------------------------------------- 505 IF ( ln_NOOS ) THEN 506 WRITE(numout,*) 'Coords and direction read' 507 ENDIF 508 407 509 coordtemp(:) = POINT_SECTION(0,0) !list of points read 408 510 directemp(:) = 0 !value of directions of each points … … 416 518 !debug 417 519 !----- 418 IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) )THEN520 !IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) )THEN 419 521 WRITE(numout,*)" List of points in global domain:" 420 522 DO jpt=1,iptglo 421 523 WRITE(numout,*)' # I J ',jpt,coordtemp(jpt),directemp(jpt) 422 524 ENDDO 423 ENDIF 424 525 !ENDIF 526 527 WRITE(numout,*) 'Debug section done' 528 425 529 !Now each proc selects only points that are in its domain: 426 530 !-------------------------------------------------------- … … 624 728 !!-------------------------------------------------------- 625 729 626 IF( ld_debug )WRITE(numout,*)' Compute transport'730 !!NIALL IF( ld_debug )WRITE(numout,*)' Compute transport' 627 731 628 732 !---------------------------! … … 754 858 transports_3d(2,jsec,jseg,jk) = transports_3d(2,jsec,jseg,jk) + zTnorm * ztn * zrhop * rcp 755 859 transports_3d(3,jsec,jseg,jk) = transports_3d(3,jsec,jseg,jk) + zTnorm * zsn * zrhop * 0.001 860 transports_3d(4,jsec,jseg,jk) = transports_3d(4,jsec,jseg,jk) + zTnorm * 4.e+3_wp * (ztn+273.15) * 1026._wp 861 transports_3d(5,jsec,jseg,jk) = transports_3d(5,jsec,jseg,jk) + zTnorm * 0.001 * zsn * 1026._wp 756 862 ENDIF 757 863 … … 809 915 END SUBROUTINE transport 810 916 917 SUBROUTINE transport_h(sec,ld_debug,jsec) 918 !!------------------------------------------------------------------------------------------- 919 !! *** ROUTINE hourly_transport *** 920 !! 921 !! Exactly as routine transport but for data summed at 922 !! each time step and averaged each hour 923 !! 924 !! Purpose :: Compute the transport for each point in a section 925 !! 926 !! Method :: Loop over each segment, and each vertical level and add the transport 927 !! Be aware : 928 !! One section is a sum of segments 929 !! One segment is defined by 2 consecutive points in sec%listPoint 930 !! All points of sec%listPoint are positioned on the F-point of the cell 931 !! 932 !! There are two loops: 933 !! loop on the segment between 2 nodes 934 !! loop on the level jk 935 !! 936 !! ** Output: Arrays containing the volume,density,salinity,temperature etc 937 !! transports for each point in a section, summed over each nn_dct. 938 !! 939 !!------------------------------------------------------------------------------------------- 940 !! * Arguments 941 TYPE(SECTION),INTENT(INOUT) :: sec 942 LOGICAL ,INTENT(IN) :: ld_debug 943 INTEGER ,INTENT(IN) :: jsec ! numeric identifier of section 944 945 !! * Local variables 946 INTEGER :: jk,jseg,jclass, &!loop on level/segment/classes 947 isgnu , isgnv ! 948 REAL(wp):: zumid , zvmid , &!U/V velocity on a cell segment 949 zumid_ice , zvmid_ice , &!U/V ice velocity 950 zTnorm !transport of velocity through one cell's sides 951 REAL(wp):: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point 952 953 TYPE(POINT_SECTION) :: k 954 !!-------------------------------------------------------- 955 956 !!NIALL IF( ld_debug )WRITE(numout,*)' Compute transport' 957 958 !---------------------------! 959 ! COMPUTE TRANSPORT ! 960 !---------------------------! 961 IF(sec%nb_point .NE. 0)THEN 962 963 !---------------------------------------------------------------------------------------------------- 964 !Compute sign for velocities: 965 ! 966 !convention: 967 ! non horizontal section: direction + is toward left hand of section 968 ! horizontal section: direction + is toward north of section 969 ! 970 ! 971 ! slopeSection < 0 slopeSection > 0 slopeSection=inf slopeSection=0 972 ! ---------------- ----------------- --------------- -------------- 973 ! 974 ! isgnv=1 direction + 975 ! ______ _____ ______ 976 ! | //| | | direction + 977 ! | isgnu=1 // | |isgnu=1 |isgnu=1 /|\ 978 ! |_______ // ______| \\ | ---\ | 979 ! | | isgnv=-1 \\ | | ---/ direction + ____________ 980 ! | | __\\| | 981 ! | | direction + | isgnv=1 982 ! 983 !---------------------------------------------------------------------------------------------------- 984 isgnu = 1 985 IF( sec%slopeSection .GT. 0 ) THEN ; isgnv = -1 986 ELSE ; isgnv = 1 987 ENDIF 988 989 IF( ld_debug )write(numout,*)"isgnu isgnv ",isgnu,isgnv 990 991 !--------------------------------------! 992 ! LOOP ON THE SEGMENT BETWEEN 2 NODES ! 993 !--------------------------------------! 994 DO jseg=1,MAX(sec%nb_point-1,0) 995 996 !------------------------------------------------------------------------------------------- 997 ! Select the appropriate coordinate for computing the velocity of the segment 998 ! 999 ! CASE(0) Case (2) 1000 ! ------- -------- 1001 ! listPoint(jseg) listPoint(jseg+1) listPoint(jseg) F(i,j) 1002 ! F(i,j)----------V(i+1,j)-------F(i+1,j) | 1003 ! | 1004 ! | 1005 ! | 1006 ! Case (3) U(i,j) 1007 ! -------- | 1008 ! | 1009 ! listPoint(jseg+1) F(i,j+1) | 1010 ! | | 1011 ! | | 1012 ! | listPoint(jseg+1) F(i,j-1) 1013 ! | 1014 ! | 1015 ! U(i,j+1) 1016 ! | Case(1) 1017 ! | ------ 1018 ! | 1019 ! | listPoint(jseg+1) listPoint(jseg) 1020 ! | F(i-1,j)-----------V(i,j) -------f(jseg) 1021 ! listPoint(jseg) F(i,j) 1022 ! 1023 !------------------------------------------------------------------------------------------- 1024 1025 SELECT CASE( sec%direction(jseg) ) 1026 CASE(0) ; k = sec%listPoint(jseg) 1027 CASE(1) ; k = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J) 1028 CASE(2) ; k = sec%listPoint(jseg) 1029 CASE(3) ; k = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1) 1030 END SELECT 1031 1032 !---------------------------| 1033 ! LOOP ON THE LEVEL | 1034 !---------------------------| 1035 !Sum of the transport on the vertical 1036 DO jk=1,mbathy(k%I,k%J) 1037 1038 ! compute temparature, salinity, insitu & potential density, ssh and depth at U/V point 1039 SELECT CASE( sec%direction(jseg) ) 1040 CASE(0,1) 1041 ztn = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) ) 1042 zsn = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) ) 1043 zrhop = interp(k%I,k%J,jk,'V',rhop) 1044 zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0) 1045 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1) ) * vmask(k%I,k%J,1) 1046 CASE(2,3) 1047 ztn = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) ) 1048 zsn = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) ) 1049 zrhop = interp(k%I,k%J,jk,'U',rhop) 1050 zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0) 1051 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1) 1052 END SELECT 1053 1054 zfsdep= fsdept(k%I,k%J,jk) 1055 1056 !compute velocity with the correct direction 1057 SELECT CASE( sec%direction(jseg) ) 1058 CASE(0,1) 1059 zumid=0. 1060 zvmid=isgnv*vn(k%I,k%J,jk)*vmask(k%I,k%J,jk) 1061 CASE(2,3) 1062 zumid=isgnu*un(k%I,k%J,jk)*umask(k%I,k%J,jk) 1063 zvmid=0. 1064 END SELECT 1065 1066 !zTnorm=transport through one cell; 1067 !velocity* cell's length * cell's thickness 1068 zTnorm=zumid*e2u(k%I,k%J)* fse3u(k%I,k%J,jk)+ & 1069 zvmid*e1v(k%I,k%J)* fse3v(k%I,k%J,jk) 1070 1071 #if ! defined key_vvl 1072 !add transport due to free surface 1073 IF( jk==1 )THEN 1074 zTnorm = zTnorm + zumid* e2u(k%I,k%J) * zsshn * umask(k%I,k%J,jk) + & 1075 zvmid* e1v(k%I,k%J) * zsshn * vmask(k%I,k%J,jk) 1076 ENDIF 1077 #endif 1078 !COMPUTE TRANSPORT 1079 1080 transports_3d_h(1,jsec,jseg,jk) = transports_3d_h(1,jsec,jseg,jk) + zTnorm 1081 1082 IF ( sec%llstrpond ) THEN 1083 transports_3d_h(2,jsec,jseg,jk) = transports_3d_h(2,jsec,jseg,jk) + zTnorm * zrhoi 1084 transports_3d_h(3,jsec,jseg,jk) = transports_3d_h(3,jsec,jseg,jk) + zTnorm * zrhop 1085 transports_3d_h(4,jsec,jseg,jk) = transports_3d_h(4,jsec,jseg,jk) + zTnorm * 4.e+3_wp * (ztn+273.15) * 1026._wp 1086 transports_3d_h(5,jsec,jseg,jk) = transports_3d_h(5,jsec,jseg,jk) + zTnorm * 0.001 * zsn * 1026._wp 1087 ENDIF 1088 1089 ENDDO !end of loop on the level 1090 1091 #if defined key_lim2 || defined key_lim3 1092 1093 !ICE CASE 1094 !------------ 1095 IF( sec%ll_ice_section )THEN 1096 SELECT CASE (sec%direction(jseg)) 1097 CASE(0) 1098 zumid_ice = 0 1099 zvmid_ice = isgnv*0.5*(v_ice(k%I,k%J+1)+v_ice(k%I+1,k%J+1)) 1100 CASE(1) 1101 zumid_ice = 0 1102 zvmid_ice = isgnv*0.5*(v_ice(k%I,k%J+1)+v_ice(k%I+1,k%J+1)) 1103 CASE(2) 1104 zvmid_ice = 0 1105 zumid_ice = isgnu*0.5*(u_ice(k%I+1,k%J)+u_ice(k%I+1,k%J+1)) 1106 CASE(3) 1107 zvmid_ice = 0 1108 zumid_ice = isgnu*0.5*(u_ice(k%I+1,k%J)+u_ice(k%I+1,k%J+1)) 1109 END SELECT 1110 1111 zTnorm=zumid_ice*e2u(k%I,k%J)+zvmid_ice*e1v(k%I,k%J) 1112 1113 transports_2d_h(1,jsec,jseg) = transports_2d_h(1,jsec,jseg) + (zTnorm)* & 1114 (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) & 1115 *(hsnif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J) + & 1116 hicif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) & 1117 +zice_vol_pos 1118 transports_2d_h(2,jsec,jseg) = transports_2d_h(2,jsec,jseg) + (zTnorm)* & 1119 (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) & 1120 +zice_surf_pos 1121 1122 ENDIF !end of ice case 1123 #endif 1124 1125 ENDDO !end of loop on the segment 1126 1127 ENDIF !end of sec%nb_point =0 case 1128 ! 1129 END SUBROUTINE transport_h 1130 811 1131 SUBROUTINE dia_dct_sum(sec,jsec) 812 1132 !!------------------------------------------------------------- … … 957 1277 sec%transport(6,jclass) = sec%transport(6,jclass)+transports_3d(3,jsec,jseg,jk) 958 1278 ENDIF 1279 1280 IF ( transports_3d(4,jsec,jseg,jk) .GE. 0.0 ) THEN 1281 sec%transport(7,jclass) = sec%transport(7,jclass)+transports_3d(4,jsec,jseg,jk) 1282 ELSE 1283 sec%transport(8,jclass) = sec%transport(8,jclass)+transports_3d(4,jsec,jseg,jk) 1284 ENDIF 1285 1286 IF ( transports_3d(5,jsec,jseg,jk) .GE. 0.0 ) THEN 1287 sec%transport( 9,jclass) = sec%transport( 9,jclass)+transports_3d(5,jsec,jseg,jk) 1288 ELSE 1289 sec%transport(10,jclass) = sec%transport(10,jclass)+transports_3d(5,jsec,jseg,jk) 1290 ENDIF 959 1291 960 1292 ELSE … … 963 1295 sec%transport( 5,jclass) = 0._wp 964 1296 sec%transport( 6,jclass) = 0._wp 1297 sec%transport( 7,jclass) = 0._wp 1298 sec%transport( 8,jclass) = 0._wp 1299 sec%transport( 9,jclass) = 0._wp 1300 sec%transport(10,jclass) = 0._wp 965 1301 ENDIF 966 1302 … … 977 1313 978 1314 IF ( transports_2d(1,jsec,jseg) .GE. 0.0 ) THEN 979 sec%transport( 7,1) = sec%transport( 7,1)+transports_2d(1,jsec,jseg)*1.E-61315 sec%transport(11,1) = sec%transport(11,1)+transports_2d(1,jsec,jseg)*1.E-6 980 1316 ELSE 981 sec%transport( 8,1) = sec%transport( 8,1)+transports_2d(1,jsec,jseg)*1.E-61317 sec%transport(12,1) = sec%transport(12,1)+transports_2d(1,jsec,jseg)*1.E-6 982 1318 ENDIF 983 1319 984 1320 IF ( transports_2d(3,jsec,jseg) .GE. 0.0 ) THEN 985 sec%transport( 9,1) = sec%transport( 9,1)+transports_2d(2,jsec,jseg)*1.E-61321 sec%transport(13,1) = sec%transport(13,1)+transports_2d(2,jsec,jseg)*1.E-6 986 1322 ELSE 987 sec%transport(1 0,1) = sec%transport(10,1)+transports_2d(2,jsec,jseg)*1.E-61323 sec%transport(14,1) = sec%transport(14,1)+transports_2d(2,jsec,jseg)*1.E-6 988 1324 ENDIF 989 1325 … … 995 1331 ELSE !if sec%nb_point =0 996 1332 sec%transport(1:2,:)=0. 997 IF (sec%llstrpond) sec%transport(3: 6,:)=0.998 IF (sec%ll_ice_section) sec%transport( 7:10,:)=0.1333 IF (sec%llstrpond) sec%transport(3:10,:)=0. 1334 IF (sec%ll_ice_section) sec%transport(11:14,:)=0. 999 1335 ENDIF !end of sec%nb_point =0 case 1000 1336 1001 1337 END SUBROUTINE dia_dct_sum 1338 1339 SUBROUTINE dia_dct_sum_h(sec,jsec) 1340 !!------------------------------------------------------------- 1341 !! Exactly as dia_dct_sum but for hourly files containing data summed at each time step 1342 !! 1343 !! Purpose: Average the transport over nn_dctwri time steps 1344 !! and sum over the density/salinity/temperature/depth classes 1345 !! 1346 !! Method: 1347 !! Sum over relevant grid cells to obtain values 1348 !! for each 1349 !! There are several loops: 1350 !! loop on the segment between 2 nodes 1351 !! loop on the level jk 1352 !! loop on the density/temperature/salinity/level classes 1353 !! test on the density/temperature/salinity/level 1354 !! 1355 !! ** Method :Transport through a given section is equal to the sum of transports 1356 !! computed on each proc. 1357 !! On each proc,transport is equal to the sum of transport computed through 1358 !! segments linking each point of sec%listPoint with the next one. 1359 !! 1360 !!------------------------------------------------------------- 1361 !! * arguments 1362 TYPE(SECTION),INTENT(INOUT) :: sec 1363 INTEGER ,INTENT(IN) :: jsec ! numeric identifier of section 1364 1365 TYPE(POINT_SECTION) :: k 1366 INTEGER :: jk,jseg,jclass !loop on level/segment/classes 1367 REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point 1368 !!------------------------------------------------------------- 1369 1370 !! Sum the relevant segments to obtain values for each class 1371 IF(sec%nb_point .NE. 0)THEN 1372 1373 !--------------------------------------! 1374 ! LOOP ON THE SEGMENT BETWEEN 2 NODES ! 1375 !--------------------------------------! 1376 DO jseg=1,MAX(sec%nb_point-1,0) 1377 1378 !------------------------------------------------------------------------------------------- 1379 ! Select the appropriate coordinate for computing the velocity of the segment 1380 ! 1381 ! CASE(0) Case (2) 1382 ! ------- -------- 1383 ! listPoint(jseg) listPoint(jseg+1) listPoint(jseg) F(i,j) 1384 ! F(i,j)----------V(i+1,j)-------F(i+1,j) | 1385 ! | 1386 ! | 1387 ! | 1388 ! Case (3) U(i,j) 1389 ! -------- | 1390 ! | 1391 ! listPoint(jseg+1) F(i,j+1) | 1392 ! | | 1393 ! | | 1394 ! | listPoint(jseg+1) F(i,j-1) 1395 ! | 1396 ! | 1397 ! U(i,j+1) 1398 ! | Case(1) 1399 ! | ------ 1400 ! | 1401 ! | listPoint(jseg+1) listPoint(jseg) 1402 ! | F(i-1,j)-----------V(i,j) -------f(jseg) 1403 ! listPoint(jseg) F(i,j) 1404 ! 1405 !------------------------------------------------------------------------------------------- 1406 1407 SELECT CASE( sec%direction(jseg) ) 1408 CASE(0) ; k = sec%listPoint(jseg) 1409 CASE(1) ; k = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J) 1410 CASE(2) ; k = sec%listPoint(jseg) 1411 CASE(3) ; k = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1) 1412 END SELECT 1413 1414 !---------------------------| 1415 ! LOOP ON THE LEVEL | 1416 !---------------------------| 1417 !Sum of the transport on the vertical 1418 DO jk=1,mbathy(k%I,k%J) 1419 1420 ! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point 1421 SELECT CASE( sec%direction(jseg) ) 1422 CASE(0,1) 1423 ztn = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) ) 1424 zsn = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) ) 1425 zrhop = interp(k%I,k%J,jk,'V',rhop) 1426 zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0) 1427 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1) ) * vmask(k%I,k%J,1) 1428 CASE(2,3) 1429 ztn = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) ) 1430 zsn = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) ) 1431 zrhop = interp(k%I,k%J,jk,'U',rhop) 1432 zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0) 1433 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1) 1434 END SELECT 1435 1436 zfsdep= fsdept(k%I,k%J,jk) 1437 1438 !------------------------------- 1439 ! LOOP ON THE DENSITY CLASSES | 1440 !------------------------------- 1441 !The computation is made for each density/heat/salt/... class 1442 DO jclass=1,MAX(1,sec%nb_class-1) 1443 1444 !----------------------------------------------! 1445 !TEST ON THE DENSITY/SALINITY/TEMPERATURE/LEVEL! 1446 !----------------------------------------------! 1447 1448 IF ( ( & 1449 ((( zrhop .GE. (sec%zsigp(jclass)+1000. )) .AND. & 1450 ( zrhop .LE. (sec%zsigp(jclass+1)+1000. ))) .OR. & 1451 ( sec%zsigp(jclass) .EQ. 99.)) .AND. & 1452 1453 ((( zrhoi .GE. (sec%zsigi(jclass) + 1000. )) .AND. & 1454 ( zrhoi .LE. (sec%zsigi(jclass+1)+1000. ))) .OR. & 1455 ( sec%zsigi(jclass) .EQ. 99.)) .AND. & 1456 1457 ((( zsn .GT. sec%zsal(jclass)) .AND. & 1458 ( zsn .LE. sec%zsal(jclass+1))) .OR. & 1459 ( sec%zsal(jclass) .EQ. 99.)) .AND. & 1460 1461 ((( ztn .GE. sec%ztem(jclass)) .AND. & 1462 ( ztn .LE. sec%ztem(jclass+1))) .OR. & 1463 ( sec%ztem(jclass) .EQ.99.)) .AND. & 1464 1465 ((( zfsdep .GE. sec%zlay(jclass)) .AND. & 1466 ( zfsdep .LE. sec%zlay(jclass+1))) .OR. & 1467 ( sec%zlay(jclass) .EQ. 99. )) & 1468 )) THEN 1469 1470 !SUM THE TRANSPORTS FOR EACH CLASSES FOR THE POSITIVE AND NEGATIVE DIRECTIONS 1471 !---------------------------------------------------------------------------- 1472 IF (transports_3d_h(1,jsec,jseg,jk) .GE. 0.0) THEN 1473 sec%transport_h(1,jclass) = sec%transport_h(1,jclass)+transports_3d_h(1,jsec,jseg,jk) 1474 ELSE 1475 sec%transport_h(2,jclass) = sec%transport_h(2,jclass)+transports_3d_h(1,jsec,jseg,jk) 1476 ENDIF 1477 IF( sec%llstrpond )THEN 1478 1479 IF ( transports_3d_h(2,jsec,jseg,jk) .GE. 0.0 ) THEN 1480 sec%transport_h(3,jclass) = sec%transport_h(3,jclass)+transports_3d_h(2,jsec,jseg,jk) 1481 ELSE 1482 sec%transport_h(4,jclass) = sec%transport_h(4,jclass)+transports_3d_h(2,jsec,jseg,jk) 1483 ENDIF 1484 1485 IF ( transports_3d_h(3,jsec,jseg,jk) .GE. 0.0 ) THEN 1486 sec%transport_h(5,jclass) = sec%transport_h(5,jclass)+transports_3d_h(3,jsec,jseg,jk) 1487 ELSE 1488 sec%transport_h(6,jclass) = sec%transport_h(6,jclass)+transports_3d_h(3,jsec,jseg,jk) 1489 ENDIF 1490 1491 IF ( transports_3d_h(4,jsec,jseg,jk) .GE. 0.0 ) THEN 1492 sec%transport_h(7,jclass) = sec%transport_h(7,jclass)+transports_3d_h(4,jsec,jseg,jk) 1493 ELSE 1494 sec%transport_h(8,jclass) = sec%transport_h(8,jclass)+transports_3d_h(4,jsec,jseg,jk) 1495 ENDIF 1496 1497 IF ( transports_3d_h(5,jsec,jseg,jk) .GE. 0.0 ) THEN 1498 sec%transport_h( 9,jclass) = sec%transport_h( 9,jclass)+transports_3d_h(5,jsec,jseg,jk) 1499 ELSE 1500 sec%transport_h(10,jclass) = sec%transport_h(10,jclass)+transports_3d_h(5,jsec,jseg,jk) 1501 ENDIF 1502 1503 ELSE 1504 sec%transport_h( 3,jclass) = 0._wp 1505 sec%transport_h( 4,jclass) = 0._wp 1506 sec%transport_h( 5,jclass) = 0._wp 1507 sec%transport_h( 6,jclass) = 0._wp 1508 sec%transport_h( 7,jclass) = 0._wp 1509 sec%transport_h( 8,jclass) = 0._wp 1510 sec%transport_h( 9,jclass) = 0._wp 1511 sec%transport_h(10,jclass) = 0._wp 1512 ENDIF 1513 1514 ENDIF ! end of test if point is in class 1515 1516 ENDDO ! end of loop on the classes 1517 1518 ENDDO ! loop over jk 1519 1520 #if defined key_lim2 || defined key_lim3 1521 1522 !ICE CASE 1523 IF( sec%ll_ice_section )THEN 1524 1525 IF ( transports_2d_h(1,jsec,jseg) .GE. 0.0 ) THEN 1526 sec%transport_h(11,1) = sec%transport_h(11,1)+transports_2d_h(1,jsec,jseg) 1527 ELSE 1528 sec%transport_h(12,1) = sec%transport_h(12,1)+transports_2d_h(1,jsec,jseg) 1529 ENDIF 1530 1531 IF ( transports_2d_h(3,jsec,jseg) .GE. 0.0 ) THEN 1532 sec%transport_h(13,1) = sec%transport_h(13,1)+transports_2d_h(2,jsec,jseg) 1533 ELSE 1534 sec%transport_h(14,1) = sec%transport_h(14,1)+transports_2d_h(2,jsec,jseg) 1535 ENDIF 1536 1537 ENDIF !end of ice case 1538 #endif 1539 1540 ENDDO !end of loop on the segment 1541 1542 ELSE !if sec%nb_point =0 1543 sec%transport_h(1:2,:)=0. 1544 IF (sec%llstrpond) sec%transport_h(3:10,:)=0. 1545 IF (sec%ll_ice_section) sec%transport_h( 11:14,:)=0. 1546 ENDIF !end of sec%nb_point =0 case 1547 1548 END SUBROUTINE dia_dct_sum_h 1002 1549 1550 SUBROUTINE dia_dct_wri_NOOS(kt,ksec,sec) 1551 !!------------------------------------------------------------- 1552 !! Write transport output in numdct using NOOS formatting 1553 !! 1554 !! Purpose: Write transports in ascii files 1555 !! 1556 !! Method: 1557 !! 1. Write volume transports in "volume_transport" 1558 !! Unit: Sv : area * Velocity / 1.e6 1559 !! 1560 !! 2. Write heat transports in "heat_transport" 1561 !! Unit: Peta W : area * Velocity * T * rhau * Cp / 1.e15 1562 !! 1563 !! 3. Write salt transports in "salt_transport" 1564 !! Unit: 10^9 g m^3 / s : area * Velocity * S / 1.e6 1565 !! 1566 !!------------------------------------------------------------- 1567 !!arguments 1568 INTEGER, INTENT(IN) :: kt ! time-step 1569 TYPE(SECTION), INTENT(INOUT) :: sec ! section to write 1570 INTEGER ,INTENT(IN) :: ksec ! section number 1571 1572 !!local declarations 1573 INTEGER :: jclass,ji ! Dummy loop 1574 CHARACTER(len=2) :: classe ! Classname 1575 REAL(wp) :: zbnd1,zbnd2 ! Class bounds 1576 REAL(wp) :: zslope ! section's slope coeff 1577 ! 1578 REAL(wp), POINTER, DIMENSION(:):: zsumclasses ! 1D workspace 1579 !!------------------------------------------------------------- 1580 CALL wrk_alloc(nb_type_class , zsumclasses ) 1581 1582 zsumclasses(:)=0._wp 1583 zslope = sec%slopeSection 1584 1585 WRITE(numdct_NOOS,'(I4,a1,I2,a1,I2,a12,i3,a17,i3,a10,a25)') nyear,'.',nmonth,'.',nday,' Transect:',ksec-1,' No. of layers:',sec%nb_class-1,' Name: ',sec%name 1586 1587 DO jclass=1,MAX(1,sec%nb_class-1) 1588 zsumclasses(1:nb_type_class)=zsumclasses(1:nb_type_class)+sec%transport(1:nb_type_class,jclass) 1589 ENDDO 1590 1591 classe = 'total ' 1592 zbnd1 = 0._wp 1593 zbnd2 = 0._wp 1594 1595 IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 1596 WRITE(numdct_NOOS,'(9e12.4E2)') -(zsumclasses( 1)+zsumclasses( 2)), -zsumclasses( 2),-zsumclasses( 1), & 1597 -(zsumclasses( 7)+zsumclasses( 8)), -zsumclasses( 8),-zsumclasses( 7), & 1598 -(zsumclasses( 9)+zsumclasses(10)), -zsumclasses(10),-zsumclasses( 9) 1599 ELSE 1600 WRITE(numdct_NOOS,'(9e12.4E2)') zsumclasses( 1)+zsumclasses( 2) , zsumclasses( 1), zsumclasses( 2), & 1601 zsumclasses( 7)+zsumclasses( 8) , zsumclasses( 7), zsumclasses( 8), & 1602 zsumclasses( 9)+zsumclasses(10) , zsumclasses( 9), zsumclasses(10) 1603 ENDIF 1604 1605 DO jclass=1,MAX(1,sec%nb_class-1) 1606 1607 classe = 'N ' 1608 zbnd1 = 0._wp 1609 zbnd2 = 0._wp 1610 1611 !insitu density classes transports 1612 IF( ( sec%zsigi(jclass) .NE. 99._wp ) .AND. & 1613 ( sec%zsigi(jclass+1) .NE. 99._wp ) )THEN 1614 classe = 'DI ' 1615 zbnd1 = sec%zsigi(jclass) 1616 zbnd2 = sec%zsigi(jclass+1) 1617 ENDIF 1618 !potential density classes transports 1619 IF( ( sec%zsigp(jclass) .NE. 99._wp ) .AND. & 1620 ( sec%zsigp(jclass+1) .NE. 99._wp ) )THEN 1621 classe = 'DP ' 1622 zbnd1 = sec%zsigp(jclass) 1623 zbnd2 = sec%zsigp(jclass+1) 1624 ENDIF 1625 !depth classes transports 1626 IF( ( sec%zlay(jclass) .NE. 99._wp ) .AND. & 1627 ( sec%zlay(jclass+1) .NE. 99._wp ) )THEN 1628 classe = 'Z ' 1629 zbnd1 = sec%zlay(jclass) 1630 zbnd2 = sec%zlay(jclass+1) 1631 ENDIF 1632 !salinity classes transports 1633 IF( ( sec%zsal(jclass) .NE. 99._wp ) .AND. & 1634 ( sec%zsal(jclass+1) .NE. 99._wp ) )THEN 1635 classe = 'S ' 1636 zbnd1 = sec%zsal(jclass) 1637 zbnd2 = sec%zsal(jclass+1) 1638 ENDIF 1639 !temperature classes transports 1640 IF( ( sec%ztem(jclass) .NE. 99._wp ) .AND. & 1641 ( sec%ztem(jclass+1) .NE. 99._wp ) ) THEN 1642 classe = 'T ' 1643 zbnd1 = sec%ztem(jclass) 1644 zbnd2 = sec%ztem(jclass+1) 1645 ENDIF 1646 1647 !write volume transport per class 1648 IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 1649 WRITE(numdct_NOOS,'(9e12.4E2)') -(sec%transport( 1,jclass)+sec%transport( 2,jclass)),-sec%transport( 2,jclass),-sec%transport( 1,jclass), & 1650 -(sec%transport( 7,jclass)+sec%transport( 8,jclass)),-sec%transport( 8,jclass),-sec%transport( 7,jclass), & 1651 -(sec%transport( 9,jclass)+sec%transport(10,jclass)),-sec%transport(10,jclass),-sec%transport( 9,jclass) 1652 ELSE 1653 WRITE(numdct_NOOS,'(9e12.4E2)') sec%transport( 1,jclass)+sec%transport( 2,jclass) , sec%transport( 1,jclass), sec%transport( 2,jclass), & 1654 sec%transport( 7,jclass)+sec%transport( 8,jclass) , sec%transport( 7,jclass), sec%transport( 8,jclass), & 1655 sec%transport( 9,jclass)+sec%transport(10,jclass) , sec%transport( 9,jclass), sec%transport(10,jclass) 1656 ENDIF 1657 1658 ENDDO 1659 1660 CALL wrk_dealloc(nb_type_class , zsumclasses ) 1661 1662 END SUBROUTINE dia_dct_wri_NOOS 1663 1664 SUBROUTINE dia_dct_wri_NOOS_h(hr,ksec,sec) 1665 !!------------------------------------------------------------- 1666 !! As routine dia_dct_wri_NOOS but for hourly output files 1667 !! 1668 !! Write transport output in numdct using NOOS formatting 1669 !! 1670 !! Purpose: Write transports in ascii files 1671 !! 1672 !! Method: 1673 !! 1. Write volume transports in "volume_transport" 1674 !! Unit: Sv : area * Velocity / 1.e6 1675 !! 1676 !!------------------------------------------------------------- 1677 !!arguments 1678 INTEGER, INTENT(IN) :: hr ! hour 1679 TYPE(SECTION), INTENT(INOUT) :: sec ! section to write 1680 INTEGER ,INTENT(IN) :: ksec ! section number 1681 1682 !!local declarations 1683 INTEGER :: jclass,jhr ! Dummy loop 1684 CHARACTER(len=2) :: classe ! Classname 1685 REAL(wp) :: zbnd1,zbnd2 ! Class bounds 1686 REAL(wp) :: zslope ! section's slope coeff 1687 ! 1688 REAL(wp), POINTER, DIMENSION(:):: zsumclasses ! 1D workspace 1689 !!------------------------------------------------------------- 1690 1691 CALL wrk_alloc(nb_type_class , zsumclasses ) 1692 1693 zsumclasses(:)=0._wp 1694 zslope = sec%slopeSection 1695 1696 DO jclass=1,MAX(1,sec%nb_class-1) 1697 zsumclasses(1:nb_type_class)=zsumclasses(1:nb_type_class)+sec%transport_h(1:nb_type_class,jclass) 1698 ENDDO 1699 1700 !write volume transport per class 1701 IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 1702 z_hr_output(ksec,hr,1)=-(zsumclasses(1)+zsumclasses(2)) 1703 ELSE 1704 z_hr_output(ksec,hr,1)= (zsumclasses(1)+zsumclasses(2)) 1705 ENDIF 1706 1707 DO jclass=1,MAX(1,sec%nb_class-1) 1708 IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 1709 z_hr_output(ksec,hr,jclass+1)=-(sec%transport_h(1,jclass)+sec%transport_h(2,jclass)) 1710 ELSE 1711 z_hr_output(ksec,hr,jclass+1)= (sec%transport_h(1,jclass)+sec%transport_h(2,jclass)) 1712 ENDIF 1713 ENDDO 1714 1715 IF ( hr .eq. 48._wp ) THEN 1716 WRITE(numdct_NOOS_h,'(I4,a1,I2,a1,I2,a12,i3,a17,i3)') nyear,'.',nmonth,'.',nday,' Transect:',ksec-1,' No. of layers:',sec%nb_class-1 1717 DO jhr=25,48 1718 WRITE(numdct_NOOS_h,'(11F12.1)') z_hr_output(ksec,jhr,1), (z_hr_output(ksec,jhr,jclass+1), jclass=1,MAX(1,10) ) 1719 ENDDO 1720 ENDIF 1721 1722 CALL wrk_dealloc(nb_type_class , zsumclasses ) 1723 1724 END SUBROUTINE dia_dct_wri_NOOS_h 1725 1003 1726 SUBROUTINE dia_dct_wri(kt,ksec,sec) 1004 1727 !!------------------------------------------------------------- … … 1092 1815 WRITE(numdct_heat,119) ndastp,kt,ksec,sec%name,zslope, & 1093 1816 jclass,classe,zbnd1,zbnd2,& 1094 sec%transport( 3,jclass)*1.e-15,sec%transport(4,jclass)*1.e-15, &1095 ( sec%transport( 3,jclass)+sec%transport(4,jclass) )*1.e-151817 sec%transport(7,jclass)*1.e-15,sec%transport(8,jclass)*1.e-15, & 1818 ( sec%transport(7,jclass)+sec%transport(8,jclass) )*1.e-15 1096 1819 !write salt transport per class 1097 1820 WRITE(numdct_salt,119) ndastp,kt,ksec,sec%name,zslope, & 1098 1821 jclass,classe,zbnd1,zbnd2,& 1099 sec%transport( 5,jclass)*1.e-9,sec%transport(6,jclass)*1.e-9,&1100 (sec%transport( 5,jclass)+sec%transport(6,jclass))*1.e-91822 sec%transport(9,jclass)*1.e-9,sec%transport(10,jclass)*1.e-9,& 1823 (sec%transport(9,jclass)+sec%transport(10,jclass))*1.e-9 1101 1824 ENDIF 1102 1825 … … 1117 1840 WRITE(numdct_heat,119) ndastp,kt,ksec,sec%name,zslope, & 1118 1841 jclass,"total",zbnd1,zbnd2,& 1119 zsumclasses( 3)*1.e-15,zsumclasses(4)*1.e-15,&1120 (zsumclasses( 3)+zsumclasses(4) )*1.e-151842 zsumclasses(7)*1.e-15,zsumclasses(8)*1.e-15,& 1843 (zsumclasses(7)+zsumclasses(8) )*1.e-15 1121 1844 !write total salt transport 1122 1845 WRITE(numdct_salt,119) ndastp,kt,ksec,sec%name,zslope, & 1123 1846 jclass,"total",zbnd1,zbnd2,& 1124 zsumclasses( 5)*1.e-9,zsumclasses(6)*1.e-9,&1125 (zsumclasses( 5)+zsumclasses(6))*1.e-91847 zsumclasses(9)*1.e-9,zsumclasses(10)*1.e-9,& 1848 (zsumclasses(9)+zsumclasses(10))*1.e-9 1126 1849 ENDIF 1127 1850 … … 1131 1854 WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope,& 1132 1855 jclass,"ice_vol",zbnd1,zbnd2,& 1133 sec%transport( 7,1),sec%transport(8,1),&1134 sec%transport( 7,1)+sec%transport(8,1)1856 sec%transport(11,1),sec%transport(12,1),& 1857 sec%transport(11,1)+sec%transport(12,1) 1135 1858 !write total ice surface transport 1136 1859 WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope,& 1137 1860 jclass,"ice_surf",zbnd1,zbnd2,& 1138 sec%transport( 9,1),sec%transport(10,1), &1139 sec%transport( 9,1)+sec%transport(10,1)1861 sec%transport(13,1),sec%transport(14,1), & 1862 sec%transport(13,1)+sec%transport(14,1) 1140 1863 ENDIF 1141 1864
Note: See TracChangeset
for help on using the changeset viewer.
