Changeset 7572
- Timestamp:
- 2017-01-18T13:30:55+01:00 (7 years ago)
- Location:
- branches/UKMO/CO6_shelfclimate/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 4 edited
-
DIA/diaar5.F90 (modified) (7 diffs)
-
DIA/diadct.F90 (modified) (27 diffs)
-
DIA/diaregmean.F90 (modified) (17 diffs)
-
IOM/iom.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/CO6_shelfclimate/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r7567 r7572 40 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sn0 ! initial salinity 41 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn0 ! initial temperature 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshthster_mat ! ssh_thermosteric height 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshhlster_mat ! ssh_halosteric height 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshsteric_mat ! ssh_steric height 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: zbotpres_mat ! bottom pressure 42 46 43 47 !! * Substitutions … … 57 61 !!---------------------------------------------------------------------- 58 62 ! 59 ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk), tn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 63 ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk), tn0(jpi,jpj,jpk) , & 64 & sshthster_mat(jpi,jpj),sshhlster_mat(jpi,jpj),sshsteric_mat(jpi,jpj), & 65 & zbotpres_mat(jpi,jpj),STAT=dia_ar5_alloc ) 60 66 ! 61 67 IF( lk_mpp ) CALL mpp_sum ( dia_ar5_alloc ) … … 86 92 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop ) 87 93 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) 94 95 sshthster_mat(:,:) = 0._wp 96 sshhlster_mat(:,:) = 0._wp 97 sshsteric_mat(:,:) = 0._wp 98 zbotpres_mat(:,:) = 0._wp 88 99 89 100 zarea_ssh(:,:) = area(:,:) * sshn(:,:) … … 122 133 zssh_steric = - zarho / area_tot 123 134 CALL iom_put( 'sshthster', zssh_steric ) 124 CALL iom_put( 'sshthster_mat', -zbotpres ) 135 sshthster_mat(:,:) = -zbotpres(:,:) 136 CALL iom_put( 'sshthster_mat', sshthster_mat ) 125 137 126 138 ! … … 150 162 CALL iom_put( 'sshhlster', zssh_steric ) 151 163 !JT 152 CALL iom_put( 'sshhlster_mat', -zbotpres ) 164 sshhlster_mat(:,:) = -zbotpres(:,:) 165 CALL iom_put( 'sshhlster_mat', sshhlster_mat ) 153 166 !JT 154 167 … … 183 196 CALL iom_put( 'sshsteric', zssh_steric ) 184 197 !JT 185 CALL iom_put( 'sshsteric_mat', -zbotpres ) 198 sshsteric_mat(:,:) = -zbotpres(:,:) 199 CALL iom_put( 'sshsteric_mat', sshsteric_mat ) 186 200 !JT 187 201 … … 189 203 zztmp = rau0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 190 204 zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 191 CALL iom_put( 'botpres', zbotpres ) 205 zbotpres_mat(:,:) = zbotpres(:,:) 206 CALL iom_put( 'botpres', zbotpres_mat ) 192 207 193 208 ! ! Mean density anomalie, temperature and salinity -
branches/UKMO/CO6_shelfclimate/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r7567 r7572 34 34 USE dom_oce ! ocean space and time domain 35 35 USE phycst ! physical constants 36 USE in_out_manager ! I/O manager 36 USE in_out_manager ! I/O units 37 USE iom ! I/0 library 37 38 USE daymod ! calendar 38 39 USE dianam ! build name of file … … 170 171 171 172 172 !NAMELIST/namdct/nn_dct,nn_dctwri,nn_secdebug173 174 !IF( nn_timing == 1 ) CALL timing_start('dia_dct_init')175 176 !read namelist177 !REWIND( numnam )178 !READ ( numnam, namdct )179 173 180 174 IF( ln_NOOS ) THEN … … 214 208 CALL readsec 215 209 216 !IF (lwp) write(numout,*) 'dct after readsec'217 210 218 211 … … 277 270 278 271 279 !WRITE(numout,*) "diadct ind ii: ",kt,nproc, narea, mig(1),mig(jpi),nlci280 !WRITE(numout,*) "diadct ind jj: ",kt,nproc, narea, mjg(1),mig(jpj),nlcj281 272 282 273 … … 319 310 CALL transport(secs(jsec),lldebug,jsec) 320 311 321 !IF( lwp ) WRITE(numout,*) "diadct: call transport subroutine (kt, jsec) : ",kt,jsec322 312 323 313 ENDDO 324 !IF( lwp ) WRITE(numout,*) "diadct: called transport subroutine (kt, nb_sec) : ",kt, nb_sec325 314 326 315 IF( MOD(kt,nn_dctwri)==0 )THEN … … 368 357 ENDIF 369 358 IF ( MOD(kt,nn_dct_h)==0 ) THEN ! compute transport every nn_dct_h time steps 370 !IF ( MOD(kt,nn_dct)==0 .or. & ! compute transport every nn_dct time steps371 ! (ln_NOOS .and. kt==nn_it000 ) ) THEN ! also include first time step when calculating NOOS 25 hour averages372 359 373 360 DO jsec=1,nb_sec … … 409 396 410 397 IF( lwp .and. ln_NOOS ) THEN 411 !WRITE(numout,*) "diadct: call dia_dct_wri_NOOS_h (kt,nn_dctwri_h, kt/nn_dctwri_h,jsec) : ",kt,nn_dctwri_h, kt/nn_dctwri_h,jsec412 398 CALL dia_dct_wri_NOOS_h(kt/nn_dctwri_h,jsec,secs(jsec)) ! use NOOS specific formatting 413 !WRITE(numout,*) "diadct: called dia_dct_wri_NOOS_h (kt,jsec) : ",kt,jsec414 399 endif 415 400 !nullify transports values after writing … … 466 451 !open input file 467 452 !--------------- 468 !IF (lwp) THEN 469 !write(numout,*) 'dct low-level pre open: little endian ' 470 !OPEN(UNIT=107,FILE='section_ijglobal.diadct', FORM='UNFORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD',convert='LITTLE_ENDIAN') 471 472 write(numout,*) 'dct low-level pre open: big endian :',nproc,narea 473 OPEN(UNIT=107,FILE='section_ijglobal.diadct', FORM='UNFORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD',convert='BIG_ENDIAN') 474 475 !write(numout,*) 'dct low-level pre open: SWAP ' 476 !OPEN(UNIT=107,FILE='section_ijglobal.diadct', FORM='UNFORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD',convert='SWAP') 477 478 !write(numout,*) 'dct low-level pre open: NATIVE ' 479 !OPEN(UNIT=107,FILE='section_ijglobal.diadct', FORM='UNFORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD',convert='NATIVE') 480 481 write(numout,*) 'dct low-level opened :',nproc,narea 482 READ(107) isec 483 write(numout,*) 'dct low-level isec ', isec,nproc,narea 484 CLOSE(107) 485 !ENDIF 486 453 !write(numout,*) 'dct low-level pre open: little endian ' 454 !OPEN(UNIT=107,FILE='section_ijglobal.diadct', FORM='UNFORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD',convert='LITTLE_ENDIAN') 455 456 write(numout,*) 'dct low-level pre open: big endian :',nproc,narea 457 OPEN(UNIT=107,FILE='section_ijglobal.diadct', FORM='UNFORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD',convert='BIG_ENDIAN') 458 459 !write(numout,*) 'dct low-level pre open: SWAP ' 460 !OPEN(UNIT=107,FILE='section_ijglobal.diadct', FORM='UNFORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD',convert='SWAP') 461 462 !write(numout,*) 'dct low-level pre open: NATIVE ' 463 !OPEN(UNIT=107,FILE='section_ijglobal.diadct', FORM='UNFORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD',convert='NATIVE') 464 465 READ(107) isec 466 CLOSE(107) 487 467 488 468 CALL ctl_opn( numdct_in, 'section_ijglobal.diadct', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. ) … … 501 481 !--------------- 502 482 secs(jsec)%name='' 503 !IF( lwp ) write(numout,*) secs(jsec)%name504 483 secs(jsec)%llstrpond = .FALSE. 505 !IF( lwp ) write(numout,*) secs(jsec)%llstrpond506 484 secs(jsec)%ll_ice_section = .FALSE. 507 !IF( lwp ) write(numout,*) secs508 485 secs(jsec)%ll_date_line = .FALSE. 509 !IF( lwp ) write(numout,*) secs(jsec)%ll_date_line510 486 secs(jsec)%nb_class = 0 511 !IF( lwp ) write(numout,*) secs(jsec)%nb_class512 487 secs(jsec)%zsigi = 99._wp 513 !IF( lwp ) write(numout,*) secs(jsec)%zsigi514 488 secs(jsec)%zsigp = 99._wp 515 !IF( lwp ) write(numout,*) secs(jsec)%zsigp516 489 secs(jsec)%zsal = 99._wp 517 !IF( lwp ) write(numout,*) secs(jsec)%zsal518 490 secs(jsec)%ztem = 99._wp 519 !IF( lwp ) write(numout,*) secs(jsec)%ztem520 491 secs(jsec)%zlay = 99._wp 521 !IF( lwp ) write(numout,*) secs(jsec)%zlay522 492 secs(jsec)%transport = 0._wp 523 !IF( lwp ) write(numout,*) secs(jsec)%transport524 493 secs(jsec)%transport_h = 0._wp 525 !IF( lwp ) write(numout,*) secs(jsec)%transport_h526 494 secs(jsec)%nb_point = 0 527 !IF( lwp ) write(numout,*) secs(jsec)%nb_point528 495 529 496 !read section's number / name / computing choices / classes / slopeSection / points number 530 497 !----------------------------------------------------------------------------------------- 531 498 532 !write(numout,*) 'dct isec ', isec533 !write(numout,*) 'dct numdct_in ', numdct_in534 499 READ(numdct_in,iostat=iost) isec 535 !write(numout,*) 'dct iost ', iost536 !IF (iost .NE. 0 ) EXIT537 500 IF (iost .NE. 0 ) then 538 501 write(numout,*) 'unable to read section_ijglobal.diadct. iost = ',iost 539 !nb_sec = 2540 502 EXIT !end of file 541 503 ENDIF 542 504 543 !write(numout,*) 'dct isec', isec544 505 545 506 WRITE(cltmp,'(a,i4.4,a,i4.4)')'diadct: read sections : Problem of section number: isec= ',isec,' and jsec= ',jsec 546 !WRITE(numout,'(a,i4.4,a,i4.4)')'diadct: read sections : Problem of section number: isec= ',isec,' and jsec= ',jsec547 548 !write(numout,*) 'dct isec, jsec', isec,jsec549 507 550 508 551 509 IF( jsec .NE. isec ) CALL ctl_stop( cltmp ) 552 553 !IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) )WRITE(numout,*)"isec ",isec554 510 555 511 READ(numdct_in)secs(jsec)%name … … 599 555 coordtemp(jpt)%I = i1 600 556 coordtemp(jpt)%J = i2 601 !WRITE(numout,*)'diadct: coordtemp:', jpt,i1,i2602 557 ENDDO 603 558 READ(numdct_in)directemp(1:iptglo) … … 622 577 IF( iiglo==jpidta .AND. nimpp==1 ) iiglo = 2 623 578 624 !WRITE(numout,*)"diadct readsec: reg/glo domain:",narea,nlci,nimpp,mig(1),nlcj,njmpp,mjg(1)625 626 !diadct init: reg/glo domain: 3*1, 24, 22, 24, 22, 2*1627 579 iiloc=iiglo-jpizoom+1-nimpp+1 ! local coordinates of the point 628 580 ijloc=ijglo-jpjzoom+1-njmpp+1 ! " 629 !WRITE(numout,*)" List of limits of each processor:",jpt,nimpp,iiloc,iiglo,jpizoom+1,nimpp+1,ijloc,ijglo,jpjzoom+1,njmpp+1,nlei,nlej 630 631 632 !WRITE(*,*)"diadct readsec: ii: ",narea, jpt,iiglo,mig(1),mig(jpi),nlci 633 !WRITE(*,*)"diadct readsec: jj: ",narea, jpt,ijglo,mjg(1),mjg(jpj),nlcj 634 !WRITE(*,*)"diadct readsec: log: ",narea, iiglo .GE. mig(1),iiglo .LE. mig(1)+nlci-1 ,ijglo .GE. mjg(1),ijglo .LE. mjg(1)+nlcj-1 635 !WRITE(*,*)"diadct readsec: log: ",narea, iiglo .GE. mig(1),iiglo .LE. mig(jpi),ijglo .GE. mjg(1),ijglo .LE. mjg(jpj) 581 636 582 !verify if the point is on the local domain:(1,nlei)*(1,nlej) 637 583 IF( iiloc .GE. 1 .AND. iiloc .LE. nlei .AND. & 638 ijloc .GE. 1 .AND. ijloc .LE. nlej )THEN 639 !IF( iiglo .GE. mig(1) .AND. iiglo .LE. mig(1)+nlci-1 .AND. & 640 ! ijglo .GE. mjg(1) .AND. ijglo .LE. mjg(1)+nlcj-1 )THEN 641 642 643 !IF( iiglo .GE. mig(1) .AND. iiglo .LE. mig(jpi) .AND. & 644 ! ijglo .GE. mjg(1) .AND. ijglo .LE. mjg(jpj) )THEN 584 ijloc .GE. 1 .AND. ijloc .LE. nlej )THEN 585 645 586 WRITE(*,*)"diadct readsec: assigned proc!",narea,nproc,jpt 646 587 … … 709 650 ENDDO !end of the loop on jsec 710 651 711 !IF (lwp) write(numout,*) 'dct end of readsec loop, after exit'712 713 652 nb_sec = jsec-1 !number of section read in the file 714 653 715 654 CALL wrk_dealloc( nb_point_max, directemp ) 716 717 !IF (lwp) write(numout,*) 'dct after dealloc'718 719 655 ! 720 656 END SUBROUTINE readsec … … 1150 1086 END SELECT 1151 1087 1152 !JT zfsdep= gdept(k%I,k%J,jk)1153 !JT zfsdep= gdept_0(k%I,k%J,jk)1154 1088 zfsdep= fsdept(k%I,k%J,jk) 1155 1089 … … 1324 1258 END SELECT 1325 1259 1326 !JT zfsdep= gdept(k%I,k%J,jk)1327 !JT zfsdep= gdept_0(k%I,k%J,jk)1328 1260 zfsdep= fsdept(k%I,k%J,jk) 1329 1261 … … 1541 1473 END SELECT 1542 1474 1543 !JT zfsdep= gdept(k%I,k%J,jk)1544 !JT zfsdep= gdept_0(k%I,k%J,jk)1545 1475 zfsdep= fsdept(k%I,k%J,jk) 1546 1476 … … 1686 1616 INTEGER :: jclass,ji ! Dummy loop 1687 1617 CHARACTER(len=2) :: classe ! Classname 1618 1688 1619 REAL(wp) :: zbnd1,zbnd2 ! Class bounds 1689 1620 REAL(wp) :: zslope ! section's slope coeff 1690 1621 ! 1691 1622 REAL(wp), POINTER, DIMENSION(:):: zsumclasses ! 1D workspace 1623 CHARACTER(len=3) :: noos_sect_name ! Classname 1624 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: noos_iom_dummy 1625 INTEGER :: IERR 1626 1692 1627 !!------------------------------------------------------------- 1693 1628 … … 1713 1648 zbnd1 = 0._wp 1714 1649 zbnd2 = 0._wp 1715 1650 1651 1652 1653 write (noos_sect_name, "(I0.3)") ksec 1654 1655 !ALLOCATE( noos_iom_dummy(jpi,jpj,1), STAT= ierr ) 1656 ! IF( ierr /= 0 ) CALL ctl_stop( 'dia_dct_wri_NOOS: failed to allocate noos_iom_dummy array' ) 1657 1658 1659 ! ALLOCATE( noos_iom_dummy(jpi,jpj,9), STAT= ierr ) 1660 ! IF( ierr /= 0 ) CALL ctl_stop( 'dia_dct_wri_NOOS: failed to allocate noos_iom_dummy array' ) 1661 1662 ALLOCATE( noos_iom_dummy(jpi,jpj,3), STAT= ierr ) 1663 IF( ierr /= 0 ) CALL ctl_stop( 'dia_dct_wri_NOOS: failed to allocate noos_iom_dummy array' ) 1664 1665 1666 1667 !IF( lwp ) THEN 1668 ! 1669 ! WRITE(numout,*) "dia_dct_wri_NOOS: kt, jpi,jpj,3", kt, jpi,jpj,3 1670 ! 1671 !ENDIF 1716 1672 IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 1717 1673 WRITE(numdct_NOOS,'(9e12.4E2)') -(zsumclasses( 1)+zsumclasses( 2)), -zsumclasses( 2),-zsumclasses( 1), & 1718 1674 -(zsumclasses( 7)+zsumclasses( 8)), -zsumclasses( 8),-zsumclasses( 7), & 1719 1675 -(zsumclasses( 9)+zsumclasses(10)), -zsumclasses(10),-zsumclasses( 9) 1676 ! 1677 ! noos_iom_dummy(:,:,:) = 0. 1678 ! 1679 ! noos_iom_dummy(:,:,1) = -(zsumclasses( 1)+zsumclasses( 2)) 1680 ! noos_iom_dummy(:,:,2) = -zsumclasses( 2) 1681 ! noos_iom_dummy(:,:,3) = -zsumclasses( 1) 1682 ! noos_iom_dummy(:,:,4) = -(zsumclasses( 7)+zsumclasses( 8)) 1683 ! noos_iom_dummy(:,:,5) = -zsumclasses( 8) 1684 ! noos_iom_dummy(:,:,6) = -zsumclasses( 7) 1685 ! noos_iom_dummy(:,:,7) = -(zsumclasses( 9)+zsumclasses( 10)) 1686 ! noos_iom_dummy(:,:,8) = -zsumclasses( 10) 1687 ! noos_iom_dummy(:,:,9) = -zsumclasses( 9) 1688 ! 1689 ! CALL iom_put( "noos_" // trim(noos_sect_name), noos_iom_dummy ) 1690 ! noos_iom_dummy(:,:,:) = 0. 1691 ! 1692 1693 1694 1695 noos_iom_dummy(:,:,:) = 0. 1696 1697 noos_iom_dummy(:,:,1) = -(zsumclasses( 1)+zsumclasses( 2)) 1698 noos_iom_dummy(:,:,2) = -zsumclasses( 2) 1699 noos_iom_dummy(:,:,3) = -zsumclasses( 1) 1700 !IF( lwp ) WRITE(numout,*) "dia_dct_wri_NOOS +ve : kt, trans", kt, & 1701 ! & noos_iom_dummy(10,10,1), noos_iom_dummy(10,10,2), noos_iom_dummy(10,10,3) 1702 !CALL iom_put( "noos_" // trim(noos_sect_name) // '_trans', noos_iom_dummy ) 1703 noos_iom_dummy(:,:,:) = 0. 1704 1705 noos_iom_dummy(:,:,1) = -(zsumclasses( 7)+zsumclasses( 8)) 1706 noos_iom_dummy(:,:,2) = -zsumclasses( 8) 1707 noos_iom_dummy(:,:,3) = -zsumclasses( 7) 1708 !IF( lwp ) WRITE(numout,*) "dia_dct_wri_NOOS +ve : kt, heat", kt, & 1709 ! & noos_iom_dummy(10,10,1), noos_iom_dummy(10,10,2), noos_iom_dummy(10,10,3) 1710 !CALL iom_put( "noos_" // trim(noos_sect_name) // '_heat', noos_iom_dummy ) 1711 noos_iom_dummy(:,:,:) = 0. 1712 1713 noos_iom_dummy(:,:,1) = -(zsumclasses( 9)+zsumclasses( 10)) 1714 noos_iom_dummy(:,:,2) = -zsumclasses( 10) 1715 noos_iom_dummy(:,:,3) = -zsumclasses( 9) 1716 !IF( lwp ) WRITE(numout,*) "dia_dct_wri_NOOS +ve : kt, salt", kt, & 1717 ! & noos_iom_dummy(10,10,1), noos_iom_dummy(10,10,2), noos_iom_dummy(10,10,3) 1718 !CALL iom_put( "noos_" // trim(noos_sect_name) // '_salt', noos_iom_dummy ) 1719 noos_iom_dummy(:,:,:) = 0. 1720 1721 1722 ! 1723 ! noos_iom_dummy(:,:,:) = 0. 1724 ! 1725 ! noos_iom_dummy(:,:,1) = -(zsumclasses( 1)+zsumclasses( 2)) 1726 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_trans_tot', noos_iom_dummy ) 1727 ! noos_iom_dummy(:,:,:) = 0. 1728 ! 1729 ! noos_iom_dummy(:,:,1) = -zsumclasses( 2) 1730 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_trans_pos', noos_iom_dummy ) 1731 ! noos_iom_dummy(:,:,:) = 0. 1732 ! 1733 ! noos_iom_dummy(:,:,1) = -zsumclasses( 1) 1734 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_trans_neg', noos_iom_dummy ) 1735 ! noos_iom_dummy(:,:,:) = 0. 1736 ! 1737 ! noos_iom_dummy(:,:,1) = -(zsumclasses( 7)+zsumclasses( 8)) 1738 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_heat_tot', noos_iom_dummy ) 1739 ! noos_iom_dummy(:,:,:) = 0. 1740 ! 1741 ! noos_iom_dummy(:,:,1) = -zsumclasses( 8) 1742 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_heat_pos', noos_iom_dummy ) 1743 ! noos_iom_dummy(:,:,:) = 0. 1744 ! 1745 ! noos_iom_dummy(:,:,1) = -zsumclasses( 7) 1746 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_heat_neg', noos_iom_dummy ) 1747 ! noos_iom_dummy(:,:,:) = 0. 1748 ! 1749 ! noos_iom_dummy(:,:,1) = -(zsumclasses( 9)+zsumclasses( 10)) 1750 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_salt_tot', noos_iom_dummy ) 1751 ! noos_iom_dummy(:,:,:) = 0. 1752 ! 1753 ! noos_iom_dummy(:,:,1) = -zsumclasses( 10) 1754 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_salt_pos', noos_iom_dummy ) 1755 ! noos_iom_dummy(:,:,:) = 0. 1756 ! 1757 ! noos_iom_dummy(:,:,1) = -zsumclasses( 9) 1758 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_salt_neg', noos_iom_dummy ) 1759 ! noos_iom_dummy(:,:,:) = 0. 1760 ! 1761 1762 1720 1763 ELSE 1721 1764 WRITE(numdct_NOOS,'(9e12.4E2)') zsumclasses( 1)+zsumclasses( 2) , zsumclasses( 1), zsumclasses( 2), & 1722 1765 zsumclasses( 7)+zsumclasses( 8) , zsumclasses( 7), zsumclasses( 8), & 1723 1766 zsumclasses( 9)+zsumclasses(10) , zsumclasses( 9), zsumclasses(10) 1767 1768 1769 1770 ! 1771 ! noos_iom_dummy(:,:,:) = 0. 1772 ! 1773 ! noos_iom_dummy(:,:,1) = (zsumclasses( 1)+zsumclasses( 2)) 1774 ! noos_iom_dummy(:,:,2) = zsumclasses( 1) 1775 ! noos_iom_dummy(:,:,3) = zsumclasses( 2) 1776 ! noos_iom_dummy(:,:,4) = (zsumclasses( 7)+zsumclasses( 8)) 1777 ! noos_iom_dummy(:,:,5) = zsumclasses( 7) 1778 ! noos_iom_dummy(:,:,6) = zsumclasses( 8) 1779 ! noos_iom_dummy(:,:,7) = (zsumclasses( 9)+zsumclasses( 10)) 1780 ! noos_iom_dummy(:,:,8) = zsumclasses( 9) 1781 ! noos_iom_dummy(:,:,9) = zsumclasses( 10) 1782 ! 1783 ! CALL iom_put( "noos_" // trim(noos_sect_name), noos_iom_dummy ) 1784 1785 1786 1787 1788 noos_iom_dummy(:,:,1) = (zsumclasses( 1)+zsumclasses( 2)) 1789 noos_iom_dummy(:,:,2) = zsumclasses( 1) 1790 noos_iom_dummy(:,:,3) = zsumclasses( 2) 1791 !IF( lwp ) WRITE(numout,*) "dia_dct_wri_NOOS -ve : kt, trans", kt, & 1792 ! & noos_iom_dummy(10,10,1), noos_iom_dummy(10,10,2), noos_iom_dummy(10,10,3) 1793 !CALL iom_put( "noos_" // trim(noos_sect_name) // '_trans', noos_iom_dummy ) 1794 noos_iom_dummy(:,:,:) = 0. 1795 1796 noos_iom_dummy(:,:,1) = (zsumclasses( 7)+zsumclasses( 8)) 1797 noos_iom_dummy(:,:,2) = zsumclasses( 7) 1798 noos_iom_dummy(:,:,3) = zsumclasses( 8) 1799 !IF( lwp ) WRITE(numout,*) "dia_dct_wri_NOOS -ve : kt, heat", kt, & 1800 ! & noos_iom_dummy(10,10,1), noos_iom_dummy(10,10,2), noos_iom_dummy(10,10,3) 1801 !CALL iom_put( "noos_" // trim(noos_sect_name) // '_heat', noos_iom_dummy ) 1802 noos_iom_dummy(:,:,:) = 0. 1803 1804 noos_iom_dummy(:,:,1) = (zsumclasses( 9)+zsumclasses( 10)) 1805 noos_iom_dummy(:,:,2) = zsumclasses( 9) 1806 noos_iom_dummy(:,:,3) = zsumclasses( 10) 1807 !IF( lwp ) WRITE(numout,*) "dia_dct_wri_NOOS -ve : kt, salt", kt, & 1808 ! & noos_iom_dummy(10,10,1), noos_iom_dummy(10,10,2), noos_iom_dummy(10,10,3) 1809 !CALL iom_put( "noos_" // trim(noos_sect_name) // '_salt', noos_iom_dummy ) 1810 noos_iom_dummy(:,:,:) = 0. 1811 1812 ! 1813 ! 1814 ! 1815 ! noos_iom_dummy(:,:,1) = (zsumclasses( 1)+zsumclasses( 2)) 1816 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_trans_tot', noos_iom_dummy ) 1817 ! noos_iom_dummy(:,:,:) = 0. 1818 ! 1819 ! noos_iom_dummy(:,:,1) = zsumclasses( 1) 1820 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_trans_pos', noos_iom_dummy ) 1821 ! noos_iom_dummy(:,:,:) = 0. 1822 ! 1823 ! noos_iom_dummy(:,:,1) = zsumclasses( 2) 1824 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_trans_neg', noos_iom_dummy ) 1825 ! noos_iom_dummy(:,:,:) = 0. 1826 ! 1827 ! noos_iom_dummy(:,:,1) = (zsumclasses( 7)+zsumclasses( 8)) 1828 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_heat_tot', noos_iom_dummy ) 1829 ! noos_iom_dummy(:,:,:) = 0. 1830 ! 1831 ! noos_iom_dummy(:,:,1) = zsumclasses( 7) 1832 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_heat_pos', noos_iom_dummy ) 1833 ! noos_iom_dummy(:,:,:) = 0. 1834 ! 1835 ! noos_iom_dummy(:,:,1) = zsumclasses( 8) 1836 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_heat_neg', noos_iom_dummy ) 1837 ! noos_iom_dummy(:,:,:) = 0. 1838 ! 1839 ! noos_iom_dummy(:,:,1) = (zsumclasses( 9)+zsumclasses( 10)) 1840 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_salt_tot', noos_iom_dummy ) 1841 ! noos_iom_dummy(:,:,:) = 0. 1842 ! 1843 ! noos_iom_dummy(:,:,1) = zsumclasses( 9) 1844 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_salt_pos', noos_iom_dummy ) 1845 ! noos_iom_dummy(:,:,:) = 0. 1846 ! 1847 ! noos_iom_dummy(:,:,1) = zsumclasses( 10) 1848 ! CALL iom_put( "noos_" // trim(noos_sect_name) // '_salt_neg', noos_iom_dummy ) 1849 ! noos_iom_dummy(:,:,:) = 0. 1850 1724 1851 ENDIF 1852 1853 1854 DEALLOCATE(noos_iom_dummy) 1725 1855 1726 1856 DO jclass=1,MAX(1,sec%nb_class-1) … … 1779 1909 ENDDO 1780 1910 1781 !CALL FLUSH(numdct_NOOS)1911 CALL FLUSH(numdct_NOOS) 1782 1912 1783 1913 CALL wrk_dealloc(nb_type , zsumclasses ) … … 1810 1940 ! 1811 1941 REAL(wp), POINTER, DIMENSION(:):: zsumclasses ! 1D workspace 1942 CHARACTER(len=3) :: noos_sect_name ! Classname 1943 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: noos_iom_dummy 1944 INTEGER :: IERR 1945 1812 1946 !!------------------------------------------------------------- 1813 1947 … … 1819 1953 1820 1954 CALL wrk_alloc(nb_type , zsumclasses ) 1955 1956 1957 write (noos_sect_name, "(I03)") ksec 1958 1959 ALLOCATE( noos_iom_dummy(jpi,jpj), STAT= ierr ) 1960 IF( ierr /= 0 ) CALL ctl_stop( 'dia_dct_wri_NOOS_h: failed to allocate noos_iom_dummy array' ) 1961 1962 1963 1964 1821 1965 1822 1966 zsumclasses(:)=0._wp … … 1850 1994 1851 1995 CALL wrk_dealloc(nb_type , zsumclasses ) 1996 1997 DEALLOCATE(noos_iom_dummy) 1998 1999 2000 2001 1852 2002 1853 2003 END SUBROUTINE dia_dct_wri_NOOS_h … … 2069 2219 REAL(wp):: zet1, zet2 ! weight for interpolation 2070 2220 REAL(wp):: zdep1,zdep2 ! differences of depth 2071 REAL(wp):: zmsk ! mask value2072 2221 !!---------------------------------------------------------------------- 2073 2222 … … 2078 2227 zet1=e1t(ii1,ij1) 2079 2228 zet2=e1t(ii2,ij2) 2080 zmsk=umask(ii1,ij1,kk)2081 2229 2082 2230 … … 2087 2235 zet1=e2t(ii1,ij1) 2088 2236 zet2=e2t(ii2,ij2) 2089 zmsk=vmask(ii1,ij1,kk)2090 2237 2091 2238 ENDIF … … 2102 2249 2103 2250 ! result 2104 !JT interp = zmsk * ( zwgt2 * ptab(ii1,ij1,kk) + zwgt1 * ptab(ii1,ij1,kk) ) / ( zwgt2 + zwgt1 )2105 2251 interp = umask(ii1,ij1,kk) * ( zwgt2 * ptab(ii1,ij1,kk) + zwgt1 * ptab(ii1,ij1,kk) ) / ( zwgt2 + zwgt1 ) 2106 2252 … … 2128 2274 zbis = ptab(ii2,ij2,kk) + zwgt1 * ( ptab(ii2,ij2,kk-1) - ptab(ii2,ij2,kk) ) 2129 2275 ! result 2130 !JT interp = zmsk * ( zet2 * ptab(ii1,ij1,kk) + zet1 * zbis )/( zet1 + zet2 )2131 2276 interp = umask(ii1,ij1,kk) * ( zet2 * ptab(ii1,ij1,kk) + zet1 * zbis )/( zet1 + zet2 ) 2132 2277 ELSE … … 2134 2279 zbis = ptab(ii1,ij1,kk) + zwgt2 * ( ptab(ii1,ij1,kk-1) - ptab(ii1,ij2,kk) ) 2135 2280 ! result 2136 !JT interp = zmsk * ( zet2 * zbis + zet1 * ptab(ii2,ij2,kk) )/( zet1 + zet2 )2137 2281 interp = umask(ii1,ij1,kk) * ( zet2 * zbis + zet1 * ptab(ii2,ij2,kk) )/( zet1 + zet2 ) 2138 2282 ENDIF 2139 2283 2140 2284 ELSE 2141 !JT interp = zmsk * ( zet2 * ptab(ii1,ij1,kk) + zet1 * ptab(ii2,ij2,kk) )/( zet1 + zet2 )2142 2285 interp = umask(ii1,ij1,kk) * ( zet2 * ptab(ii1,ij1,kk) + zet1 * ptab(ii2,ij2,kk) )/( zet1 + zet2 ) 2143 2286 ENDIF -
branches/UKMO/CO6_shelfclimate/NEMOGCM/NEMO/OPA_SRC/DIA/diaregmean.F90
r7567 r7572 14 14 USE diapea ! Top,middle,bottom output 15 15 USE zdfmxl ! MLD 16 16 USE sbc_oce 17 #if defined key_diaar5 18 USE diaar5 19 #endif 17 20 IMPLICIT NONE 18 21 PRIVATE … … 31 34 LOGICAL :: ln_diaregmean_bin ! region mean calculation binary output 32 35 LOGICAL :: ln_diaregmean_nc ! region mean calculation netcdf output 36 LOGICAL :: ln_diaregmean_diaar5 ! region mean calculation including AR5 SLR terms 37 LOGICAL :: ln_diaregmean_diasbc ! region mean calculation including Surface BC 38 LOGICAL :: ln_diaregmean_karamld ! region mean calculation including kara mld terms 39 LOGICAL :: ln_diaregmean_pea ! region mean calculation including pea terms 33 40 34 41 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: tmp_region_mask_real ! tempory region_mask of reals … … 38 45 39 46 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: tmp_field_mat !: temporary region_mask 47 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: tmp_field_karamld_mat !: temporary region_mask 48 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: tmp_field_pea_mat !: temporary region_mask 49 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: tmp_field_AR5_mat !: temporary region_mask 50 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: tmp_field_SBC_mat !: temporary region_mask 40 51 INTEGER :: tmp_field_cnt ! tmp_field_cnt integer 52 INTEGER :: num_reg_vars ! number of vars in regions mean 41 53 !!---------------------------------------------------------------------- 42 54 !! NEMO/OPA 3.6 , NEMO Consortium (2014) … … 68 80 INTEGER :: zndims ! number of dimensions in an array (i.e. 3, ) 69 81 ! 70 NAMELIST/nam_diaregmean/ ln_diaregmean,ln_diaregmean_ascii,ln_diaregmean_bin,ln_diaregmean_nc 82 NAMELIST/nam_diaregmean/ ln_diaregmean,ln_diaregmean_ascii,ln_diaregmean_bin,ln_diaregmean_nc,& 83 & ln_diaregmean_karamld, ln_diaregmean_pea,ln_diaregmean_diaar5,ln_diaregmean_diasbc 84 71 85 72 86 ! read in Namelist. … … 91 105 WRITE(numout,*) 'Switch for regmean binary output (T) or not (F) ln_diaregmean_bin = ', ln_diaregmean_bin 92 106 WRITE(numout,*) 'Switch for regmean netcdf output (T) or not (F) ln_diaregmean_nc = ', ln_diaregmean_nc 107 WRITE(numout,*) 'Switch for regmean kara mld terms (T) or not (F) ln_diaregmean_karamld = ', ln_diaregmean_karamld 108 WRITE(numout,*) 'Switch for regmean PEA terms (T) or not (F) ln_diaregmean_pea = ', ln_diaregmean_pea 109 WRITE(numout,*) 'Switch for regmean AR5 SLR terms (T) or not (F) ln_diaregmean_diaar5 = ', ln_diaregmean_diaar5 110 WRITE(numout,*) 'Switch for regmean Surface forcing terms (T) or not (F) ln_diaregmean_diasbc = ', ln_diaregmean_diasbc 93 111 ENDIF 94 112 95 !ALLOCATE( tmp_field_mat(jpi,jpj,9), STAT= ierr ) 96 !ALLOCATE( tmp_field_mat(jpi,jpj,7), STAT= ierr ) !SS/NB/DT T/S, SSH 97 !ALLOCATE( tmp_field_mat(jpi,jpj,8), STAT= ierr ) !SS/NB/DT T/S, SSH, MLD 98 ALLOCATE( tmp_field_mat(jpi,jpj,11), STAT= ierr ) !SS/NB/DT T/S, SSH, MLD, PEA, PEAT, PEAS 113 num_reg_vars = 7 114 115 ALLOCATE( tmp_field_mat(jpi,jpj,num_reg_vars), STAT= ierr ) !SS/NB/DT T/S, SSH, MLD, PEA, PEAT, PEAS 99 116 IF( ierr /= 0 ) CALL ctl_stop( 'tmp_field_mat: failed to allocate tmp_region_mask_real array' ) 100 117 tmp_field_mat(:,:,:) = 0. 101 118 tmp_field_cnt = 0 119 120 IF(ln_diaregmean_karamld) THEN 121 ALLOCATE( tmp_field_karamld_mat(jpi,jpj,1), STAT= ierr ) !SS/NB/DT T/S, SSH, MLD, PEA, PEAT, PEAS 122 IF( ierr /= 0 ) CALL ctl_stop( 'tmp_field_karamld_mat: failed to allocate tmp_region_mask_real array' ) 123 tmp_field_karamld_mat(:,:,:) = 0. 124 ENDIF 125 126 IF(ln_diaregmean_pea) THEN 127 ALLOCATE( tmp_field_pea_mat(jpi,jpj,3), STAT= ierr ) !SS/NB/DT T/S, SSH, MLD, PEA, PEAT, PEAS 128 IF( ierr /= 0 ) CALL ctl_stop( 'tmp_field_pea_mat: failed to allocate tmp_region_mask_real array' ) 129 tmp_field_pea_mat(:,:,:) = 0. 130 ENDIF 131 132 IF(ln_diaregmean_diaar5) THEN 133 ALLOCATE( tmp_field_AR5_mat(jpi,jpj,4), STAT= ierr ) !SS/NB/DT T/S, SSH, MLD, PEA, PEAT, PEAS 134 IF( ierr /= 0 ) CALL ctl_stop( 'tmp_field_AR5_mat: failed to allocate tmp_region_mask_real array' ) 135 tmp_field_AR5_mat(:,:,:) = 0. 136 ENDIF 137 138 IF(ln_diaregmean_diasbc) THEN 139 ALLOCATE( tmp_field_SBC_mat(jpi,jpj,7), STAT= ierr ) !SS/NB/DT T/S, SSH, MLD, PEA, PEAT, PEAS 140 IF( ierr /= 0 ) CALL ctl_stop( 'tmp_field_SBC_mat: failed to allocate tmp_region_mask_real array' ) 141 tmp_field_SBC_mat(:,:,:) = 0. 142 ENDIF 143 144 145 146 102 147 103 148 IF (ln_diaregmean) THEN … … 272 317 tmp_field_mat(:,:,6) = tmp_field_mat(:,:,6) + zwtmbS(:,:,3) 273 318 tmp_field_mat(:,:,7) = tmp_field_mat(:,:,7) + sshn(:,:) 274 tmp_field_mat(:,:,8) = tmp_field_mat(:,:,8) + hmld_kara(:,:)!hmlp(:,:) 275 tmp_field_mat(:,:,9) = tmp_field_mat(:,:,9) + pea(:,:) 276 tmp_field_mat(:,:,10) = tmp_field_mat(:,:,10) + peat(:,:) 277 tmp_field_mat(:,:,11) = tmp_field_mat(:,:,11) + peas(:,:) 278 279 280 !tmp_field_mat(:,:,1) = tmp_field_mat(:,:,1) + zwtmbT(:,:,1) 281 !tmp_field_mat(:,:,2) = tmp_field_mat(:,:,2) + zwtmbT(:,:,2) 282 !tmp_field_mat(:,:,3) = tmp_field_mat(:,:,3) + zwtmbT(:,:,3) 283 !tmp_field_mat(:,:,4) = tmp_field_mat(:,:,4) + zwtmbT(:,:,4) 284 !tmp_field_mat(:,:,5) = tmp_field_mat(:,:,5) + zwtmbS(:,:,1) 285 !tmp_field_mat(:,:,6) = tmp_field_mat(:,:,6) + zwtmbS(:,:,2) 286 !tmp_field_mat(:,:,7) = tmp_field_mat(:,:,7) + zwtmbS(:,:,3) 287 !tmp_field_mat(:,:,8) = tmp_field_mat(:,:,8) + zwtmbS(:,:,4) 288 !tmp_field_mat(:,:,9) = tmp_field_mat(:,:,9) + sshn(:,:) 319 320 IF( ln_diaregmean_karamld ) THEN 321 tmp_field_karamld_mat(:,:,1) = tmp_field_karamld_mat(:,:,1) + hmld_kara(:,:)!hmlp(:,:) 322 ENDIF 323 324 IF( ln_diaregmean_pea ) THEN 325 tmp_field_pea_mat(:,:,1) = tmp_field_pea_mat(:,:,1) + pea(:,:) 326 tmp_field_pea_mat(:,:,2) = tmp_field_pea_mat(:,:,2) + peat(:,:) 327 tmp_field_pea_mat(:,:,3) = tmp_field_pea_mat(:,:,3) + peas(:,:) 328 ENDIF 329 330 331 IF( ln_diaregmean_diaar5 ) THEN 332 tmp_field_AR5_mat(:,:,1) = tmp_field_AR5_mat(:,:,1) + sshsteric_mat(:,:) 333 tmp_field_AR5_mat(:,:,2) = tmp_field_AR5_mat(:,:,2) + sshthster_mat(:,:) 334 tmp_field_AR5_mat(:,:,3) = tmp_field_AR5_mat(:,:,3) + sshhlster_mat(:,:) 335 tmp_field_AR5_mat(:,:,4) = tmp_field_AR5_mat(:,:,4) + zbotpres_mat(:,:) 336 ENDIF 337 338 IF( ln_diaregmean_diasbc ) THEN 339 340 tmp_field_SBC_mat(:,:,1) = tmp_field_SBC_mat(:,:,1) + ((qsr + qns)*tmask(:,:,1)) 341 tmp_field_SBC_mat(:,:,2) = tmp_field_SBC_mat(:,:,2) + (qsr*tmask(:,:,1)) 342 tmp_field_SBC_mat(:,:,3) = tmp_field_SBC_mat(:,:,3) + (qns*tmask(:,:,1)) 343 tmp_field_SBC_mat(:,:,4) = tmp_field_SBC_mat(:,:,4) + (emp*tmask(:,:,1)) 344 tmp_field_SBC_mat(:,:,5) = tmp_field_SBC_mat(:,:,5) + (wndm*tmask(:,:,1)) 345 tmp_field_SBC_mat(:,:,6) = tmp_field_SBC_mat(:,:,6) + (pressnow*tmask(:,:,1)) 346 tmp_field_SBC_mat(:,:,7) = tmp_field_SBC_mat(:,:,7) + (rnf*tmask(:,:,1)) 347 348 ENDIF 289 349 290 350 tmp_field_cnt = tmp_field_cnt + 1 … … 292 352 IF( MOD( kt, i_steps ) == 0 .and. kt .ne. nn_it000 ) THEN 293 353 294 295 296 !CALL dia_wri_region_mean(kt, "sst" , tmp_field_mat(:,:,1)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature297 !!CALL dia_wri_region_mean(kt, "mdt" , tmp_field_mat(:,:,2)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature298 !CALL dia_wri_region_mean(kt, "nbt" , tmp_field_mat(:,:,3)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature299 !CALL dia_wri_region_mean(kt, "dft" , tmp_field_mat(:,:,4)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature300 !301 ! CALL dia_wri_region_mean(kt, "sss" , tmp_field_mat(:,:,5)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Salinity302 ! !CALL dia_wri_region_mean(kt, "mds" , tmp_field_mat(:,:,6)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Salinity303 ! CALL dia_wri_region_mean(kt, "nbs" , tmp_field_mat(:,:,7)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Salinity304 ! CALL dia_wri_region_mean(kt, "dfs" , tmp_field_mat(:,:,8)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Salinity;305 !306 ! CALL dia_wri_region_mean(kt, "ssh" , tmp_field_mat(:,:,9)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature307 308 309 310 311 312 !CALL cpu_time(start_reg_mean_sub)313 354 314 355 CALL dia_wri_region_mean(kt, "sst" , tmp_field_mat(:,:,1)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature … … 322 363 CALL dia_wri_region_mean(kt, "ssh" , tmp_field_mat(:,:,7)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 323 364 324 CALL dia_wri_region_mean(kt, "mldkara" , tmp_field_mat(:,:,8)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 325 326 CALL dia_wri_region_mean(kt, "pea" , tmp_field_mat(:,:,9)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 327 CALL dia_wri_region_mean(kt, "peat" , tmp_field_mat(:,:,10)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 328 CALL dia_wri_region_mean(kt, "peas" , tmp_field_mat(:,:,11)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 329 330 !CALL cpu_time(finish_reg_mean_sub) 331 !WRITE(numout,'("kt = ",i05,"; Reg_mean_sub Time = ",f10.3," milliseconds: ",f6.3,"; ",f6.3)') & 332 ! & kt,(finish_reg_mean_sub-start_reg_mean_sub)*1000.,finish_reg_mean_sub,start_reg_mean_sub 333 365 IF( ln_diaregmean_karamld ) THEN 366 367 CALL dia_wri_region_mean(kt, "mldkara" , tmp_field_karamld_mat(:,:,1)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 368 369 ENDIF 370 371 IF( ln_diaregmean_pea ) THEN 372 373 CALL dia_wri_region_mean(kt, "pea" , tmp_field_pea_mat(:,:,1)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 374 CALL dia_wri_region_mean(kt, "peat" , tmp_field_pea_mat(:,:,2)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 375 CALL dia_wri_region_mean(kt, "peas" , tmp_field_pea_mat(:,:,3)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 376 377 ENDIF 378 379 IF( ln_diaregmean_diaar5 ) THEN 380 381 CALL dia_wri_region_mean(kt, "ssh_steric" , tmp_field_AR5_mat(:,:,1)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 382 CALL dia_wri_region_mean(kt, "ssh_thermosteric", tmp_field_AR5_mat(:,:,2)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 383 CALL dia_wri_region_mean(kt, "ssh_halosteric" , tmp_field_AR5_mat(:,:,3)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 384 CALL dia_wri_region_mean(kt, "bot_pres" , tmp_field_AR5_mat(:,:,4)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 385 386 ENDIF 387 388 IF( ln_diaregmean_diasbc ) THEN 389 390 CALL dia_wri_region_mean(kt, "qt" , tmp_field_SBC_mat(:,:,1)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 391 CALL dia_wri_region_mean(kt, "qsr" , tmp_field_SBC_mat(:,:,2)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 392 CALL dia_wri_region_mean(kt, "qns" , tmp_field_SBC_mat(:,:,3)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 393 CALL dia_wri_region_mean(kt, "emp" , tmp_field_SBC_mat(:,:,4)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 394 CALL dia_wri_region_mean(kt, "wspd" , tmp_field_SBC_mat(:,:,5)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 395 CALL dia_wri_region_mean(kt, "mslp" , tmp_field_SBC_mat(:,:,6)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 396 CALL dia_wri_region_mean(kt, "rnf" , tmp_field_SBC_mat(:,:,7)/real(tmp_field_cnt,wp))!,region_mask,nreg_mat(:,:,maskno),maskno,nreg_mat(maskno) ) ! tmb Temperature 397 398 ENDIF 399 400 401 IF( ln_diaregmean_karamld ) tmp_field_karamld_mat(:,:,:) = 0. 402 IF( ln_diaregmean_pea ) tmp_field_pea_mat(:,:,:) = 0. 403 IF( ln_diaregmean_diaar5 ) tmp_field_AR5_mat(:,:,:) = 0. 404 IF( ln_diaregmean_diasbc ) tmp_field_SBC_mat(:,:,:) = 0. 334 405 tmp_field_mat(:,:,:) = 0. 406 335 407 tmp_field_cnt = 0 336 408 … … 353 425 ENDIF 354 426 DEALLOCATE( region_mask, nreg_mat, tmp_field_mat) 427 IF( ln_diaregmean_karamld ) DEALLOCATE( tmp_field_karamld_mat) 428 IF( ln_diaregmean_pea ) DEALLOCATE( tmp_field_pea_mat) 429 IF( ln_diaregmean_diaar5 ) DEALLOCATE( tmp_field_AR5_mat) 430 IF( ln_diaregmean_diasbc ) DEALLOCATE( tmp_field_SBC_mat) 355 431 ENDIF 356 432 ENDIF … … 382 458 383 459 INTEGER, INTENT(in) :: kt 384 CHARACTER (len= 15) , INTENT(IN ) :: name460 CHARACTER (len=60) , INTENT(IN ) :: name 385 461 REAL(wp), DIMENSION(jpi, jpj), INTENT(IN ) :: infield ! Input 3d field and mask 386 462 … … 399 475 INTEGER :: ierr 400 476 REAL(wp) :: tmpreal 401 CHARACTER(LEN= 80) :: FormatString,nreg_string477 CHARACTER(LEN=180) :: FormatString,nreg_string 402 478 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: dummy_zrmet 403 479 … … 408 484 409 485 !Allocate output arrays for iomput, set to zmdi, and set a region counter = 1 410 411 !ALLOCATE( zrmet_ave(jpi,jpj,n_regions_output), STAT= ierr )412 ! IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_ave array' )413 !ALLOCATE( zrmet_tot(jpi,jpj,n_regions_output), STAT= ierr )414 ! IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_tot array' )415 !ALLOCATE( zrmet_var(jpi,jpj,n_regions_output), STAT= ierr )416 ! IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_var array' )417 !ALLOCATE( zrmet_cnt(jpi,jpj,n_regions_output), STAT= ierr )418 ! IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_cnt array' )419 !ALLOCATE( zrmet_mask_id(jpi,jpj,n_regions_output), STAT= ierr )420 ! IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_mask_id array' )421 !ALLOCATE( zrmet_reg_id(jpi,jpj,n_regions_output), STAT= ierr )422 ! IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_reg_id array' )423 424 425 486 ALLOCATE( zrmet_ave(n_regions_output), STAT= ierr ) 426 487 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_ave array' ) … … 439 500 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_reg_id array' ) 440 501 441 !zrmet_ave(:,:,:) = zmdi442 !zrmet_tot(:,:,:) = zmdi443 !zrmet_var(:,:,:) = zmdi444 !zrmet_cnt(:,:,:) = zmdi445 !zrmet_mask_id(:,:,:) = zmdi446 !zrmet_reg_id(:,:,:) = zmdi447 448 502 449 503 zrmet_ave(:) = zmdi … … 470 524 ALLOCATE( tot_mat(nreg), STAT= ierr ) 471 525 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate tot_mat array' ) 472 !ALLOCATE( tot_mat_2(nreg), STAT= ierr )473 !IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate tot_mat_2 array' )474 475 526 ALLOCATE( num_mat(nreg), STAT= ierr ) 476 527 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate num_mat array' ) … … 511 562 END DO 512 563 END DO 513 !CALL cpu_time(finish_reg_mean_loop) 514 !WRITE(numout,'("kt = ",i05,"; maskno = ",i02,"; Reg_mean_loop Time = ",f6.3," milliseconds.",f6.3,";, ",f6.3)') & 515 ! & kt,maskno,(finish_reg_mean_loop-start_reg_mean_loop)*1000.,finish_reg_mean_loop,start_reg_mean_loop 516 517 ! sum the totals, the counts, and the squares across the processors 518 !CALL cpu_time(start_reg_mean_mpp) 519 520 521 522 !IF( lk_mpp ) THEN 523 ! DO jj = 1,nreg 524 ! tmpreal = tot_mat(jj) 525 ! CALL mpp_sum( tmpreal ) 526 ! tot_mat(jj) = tmpreal 527 ! 528 ! tmpreal = ssq_mat(jj) 529 ! CALL mpp_sum( tmpreal ) 530 ! ssq_mat(jj) = tmpreal 531 ! 532 ! tmpreal = cnt_mat(jj) 533 ! CALL mpp_sum( tmpreal ) 534 ! cnt_mat(jj) = tmpreal 535 ! END DO 536 !ENDIF 537 538 539 540 !if (lwp) WRITE(numout,*) "mpp_sum loop tot_mat",tot_mat 541 !CALL cpu_time(finish_reg_mean_mpp) 542 !WRITE(numout,'("kt = ",i05,"; maskno = ",i02,"; Reg_mean_mpp Time = ",f6.3," milliseconds.",f6.3,";, ",f6.3)') & 543 ! & kt,maskno,(finish_reg_mean_loop-start_reg_mean_mpp)*1000.,finish_reg_mean_mpp,start_reg_mean_mpp 544 545 !DO jj = 1,nreg 546 ! tot_mat_2(jj) = tot_mat(jj) 547 !enddo 548 !CALL cpu_time( start_reg_mean_mpp_mat ) 549 550 564 ! sum the totals, the counts, and the squares across the processors 551 565 CALL mpp_sum( tot_mat,nreg ) 552 566 CALL mpp_sum( ssq_mat,nreg ) 553 567 CALL mpp_sum( cnt_mat,nreg ) 554 568 555 556 557 !CALL cpu_time(finish_reg_mean_mpp_mat)558 !WRITE(numout,'("kt = ",i05,"; maskno = ",i02,"; Reg_mean_mpp_mat Time = ",f6.3," milliseconds.",f6.3,";, ",f6.3)') &559 ! & kt,maskno,(finish_reg_mean_mpp_mat-start_reg_mean_mpp_mat)*1000.,finish_reg_mean_loop,start_reg_mean_mpp_mat560 561 562 !DO jj = 1,nreg563 ! WRITE(numout,*) "mpp_sum array tot_mat",jj,tot_mat(jj),ssq_mat(jj),cnt_mat(jj)564 !enddo565 569 566 570 !calculate the mean and variance from the total, sum of squares and the count. … … 608 612 609 613 DO jm = 1,nreg 610 !zrmet_ave( :,:,reg_ind_cnt) = ave_mat(jm)611 !zrmet_tot( :,:,reg_ind_cnt) = tot_mat(jm)612 !zrmet_var( :,:,reg_ind_cnt) = var_mat(jm)613 !zrmet_cnt( :,:,reg_ind_cnt) = cnt_mat(jm)614 !zrmet_reg_id( :,:,reg_ind_cnt) = reg_id_mat(jm)615 !zrmet_mask_id(:,:,reg_ind_cnt) = mask_id_mat(jm)616 617 614 zrmet_ave( reg_ind_cnt) = ave_mat(jm) 618 615 zrmet_tot( reg_ind_cnt) = tot_mat(jm) … … 637 634 638 635 639 640 !CALL iom_put( "reg_" // trim(name) // '_ave', zrmet_ave )641 !CALL iom_put( "reg_" // trim(name) // '_tot', zrmet_tot )642 !CALL iom_put( "reg_" // trim(name) // '_var', zrmet_var )643 !CALL iom_put( "reg_" // trim(name) // '_cnt', zrmet_cnt )644 !CALL iom_put( "reg_" // trim(name) // '_reg_id', zrmet_reg_id )645 !CALL iom_put( "reg_" // trim(name) // '_mask_id', zrmet_mask_id )646 636 647 637 DO jm = 1,n_regions_output -
branches/UKMO/CO6_shelfclimate/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r7567 r7572 57 57 58 58 59 !JT REGION MEANS60 !INTEGER , PUBLIC :: n_regions_output = 10061 59 62 60 INTEGER , PUBLIC :: n_regions_output 63 !JT REGION MEANS64 61 65 62 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d … … 116 113 117 114 118 !JT REGION MEANS119 !! read namelist to see if the region mask code is called, if so read the region mask, and count the regions.120 115 121 116 … … 133 128 LOGICAL :: ln_diaregmean_bin ! region mean calculation binary output 134 129 LOGICAL :: ln_diaregmean_nc ! region mean calculation netcdf output 130 LOGICAL :: ln_diaregmean_karamld ! region mean calculation including kara mld terms 131 LOGICAL :: ln_diaregmean_pea ! region mean calculation including pea terms 132 LOGICAL :: ln_diaregmean_diaar5 ! region mean calculation including AR5 SLR terms 133 LOGICAL :: ln_diaregmean_diasbc ! region mean calculation including Surface BC 135 134 136 137 138 NAMELIST/nam_diaregmean/ ln_diaregmean,ln_diaregmean_ascii,ln_diaregmean_bin,ln_diaregmean_nc 135 ! Read the number region mask to work out how many regions are needed. 136 137 NAMELIST/nam_diaregmean/ ln_diaregmean,ln_diaregmean_ascii,ln_diaregmean_bin,ln_diaregmean_nc,& 138 & ln_diaregmean_karamld, ln_diaregmean_pea,ln_diaregmean_diaar5,ln_diaregmean_diasbc 139 139 140 140 141 ! read in Namelist. … … 187 188 188 189 189 !JT REGION MEANS190 191 192 193 194 190 #if ! defined key_xios2 195 191 ALLOCATE( z_bnds(jpk,2) ) … … 319 315 CALL iom_set_axis_attr( "region", (/ (REAL(ji,wp), ji=1,n_regions_output) /) ) 320 316 321 !CALL iom_set_axis_attr( "region", (/ (REAL(ji,wp), ji=1,100) /) ) 317 !JT CALL iom_set_axis_attr( "noos", (/ (REAL(ji,wp), ji=1,9) /) ) 318 !JT CALL iom_set_axis_attr( "noos", (/ (REAL(ji,wp), ji=1,1) /) ) 319 !JT CALL iom_set_axis_attr( "noos", (/ (REAL(1,wp)) /) ) 320 CALL iom_set_axis_attr( "noos", (/ (REAL(ji,wp), ji=1,3) /) ) 322 321 323 322
Note: See TracChangeset
for help on using the changeset viewer.
