- Timestamp:
- 2013-03-12T15:55:32+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r3432 r3837 76 76 USE timing, ONLY: timing_init, timing_finalize, timing_disable, timing_enable 77 77 78 !#define ARPDEBUG78 #define ARPDEBUG 79 79 80 80 IMPLICIT NONE … … 235 235 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print 236 236 237 ! Calculate domain z dimensions as needed when partitioning. 238 ! This used to be done in par_oce.F90 when they were parameters rather 239 ! than variables 240 IF( Agrif_Root() ) THEN 241 jpk = jpkdta ! third dim 242 jpkm1 = jpk-1 ! inner domain indices 243 ENDIF 244 237 245 CALL timing_init ! Init timing module 238 246 CALL timing_disable ! but disable during startup … … 251 259 jpnj = 1 252 260 jpnij = jpni*jpnj 261 #endif 262 263 #if defined key_mpp_rkpart 264 ELSE 265 CALL ctl_stop( 'STOP', 'nemo_init : invalid inputs in namelist - cannot specify jpn{i,j}>0 when using recursive k-section paritioning!' ) 253 266 #endif 254 267 END IF … … 265 278 jpij = jpi*jpj ! jpi x j 266 279 #endif 267 jpk = jpkdta ! third dim268 jpkm1 = jpk-1 ! inner domain indices269 280 ENDIF 270 281 … … 581 592 582 593 SUBROUTINE nemo_recursive_partition( num_pes ) 583 USE dom_oce, ONLY: ln_zco, ntopo 584 USE iom, ONLY: jpiglo, jpjglo, wp, jpdom_unknown, & 585 iom_open, iom_get, iom_close 594 USE in_out_manager, ONLY: numnam 595 USE dom_oce, ONLY: ln_zco, ntopo 596 USE dom_oce, ONLY: gdepw_0, gdept_0, e3w_0, e3t_0, & 597 mig, mjg, mi0, mi1, mj0, mj1, mbathy, bathy 598 USE domzgr, ONLY: zgr_z, zgr_bat, namzgr, zgr_zco, zgr_zps 599 USE closea, ONLY: dom_clo 600 USE domain, ONLY: dom_nam 601 USE iom, ONLY: jpiglo, jpjglo, wp, jpdom_unknown, & 602 iom_open, iom_get, iom_close 586 603 USE mapcomm_mod, ONLY: ielb, ieub, pielb, pjelb, pieub, pjeub, & 587 604 iesub, jesub, jeub, ilbext, iubext, jubext, & 588 605 jlbext, pnactive, piesub, pjesub, jelb, pilbext, & 589 piubext, pjlbext, pjubext, LAND 590 USE partition_mod, ONLY: partition_rk, partition_mca_rk, imask, smooth_bathy 606 piubext, pjlbext, pjubext, LAND, msgtrim_z 607 USE partition_mod, ONLY: partition_rk, partition_mca_rk, & 608 imask, ibotlevel, partition_mask_alloc, & 609 smooth_global_bathy, global_bot_level 591 610 USE par_oce, ONLY: do_exchanges 592 611 #if defined key_mpp_mpi … … 607 626 INTEGER :: ii,jj,iproc ! Loop index 608 627 INTEGER :: jparray(2) ! Small array for gathering 628 CHARACTER(LEN=8) :: lstr ! Local string for reading env. var. 629 INTEGER :: lztrim ! Local int for " " " 609 630 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta ! temporary data workspace 610 631 !!---------------------------------------------------------------------- 611 632 612 ! Allocate masking array (stored in partition_mod) and workspace array 613 ! for this routine 614 ALLOCATE(imask(jpiglo,jpjglo), zdta(jpiglo,jpjglo), Stat=ierr) 633 ! Allocate masking arrays used in partitioning 634 CALL partition_mask_alloc(jpiglo,jpjglo,ierr) 635 IF(ierr /= 0)THEN 636 CALL ctl_stop('nemo_recursive_partition: failed to allocate masking arrays') 637 RETURN 638 END IF 639 640 ! Allocate local workspace array for this routine 641 ALLOCATE(zdta(jpiglo,jpjglo), Stat=ierr) 615 642 IF(ierr /= 0)THEN 616 643 CALL ctl_stop('nemo_recursive_partition: failed to allocate workspace arrays') … … 618 645 END IF 619 646 647 ! Check whether user has specified halo trimming in z via environment variable 648 ! Halo trimming in z is on by default 649 msgtrim_z = .TRUE. 650 CALL GET_ENVIRONMENT_VARIABLE(NAME='NEMO_MSGTRIM_Z', VALUE=lstr, STATUS=ierr) 651 IF( ierr == 0)THEN 652 READ(lstr,FMT="(I)",IOSTAT=ierr) lztrim 653 IF(ierr == 0)THEN 654 IF (lztrim == 0) msgtrim_z = .FALSE. 655 ELSE 656 CALL ctl_warn('nemo_recursive_partition: failed to parse value of NEMO_MSGTRIM_Z environment variable: '//TRIM(lstr)) 657 END IF 658 END IF 659 660 WRITE(*,*) 'ARPDBG: msgtrim_z = ',msgtrim_z 661 620 662 ! Factorise the number of MPI PEs to get jpi and jpj as usual 621 663 CALL nemo_partition(num_pes) 622 664 623 ! Generate a global mask... 624 !!$#if defined ARPDEBUG 625 !!$ IF(lwp)THEN 626 !!$ WRITE(*,*) 'ARPDBG: nemo_recursive_partition: generating mask...' 627 !!$ WRITE(*,*) 'ARPDBG: nemo_recursive_partition: jp{i,j}glo = ',jpiglo,jpjglo 628 !!$ END IF 629 !!$#endif 630 631 ! ARPDBG - this is the correct variable to check but the dom_nam section 632 ! of the namelist file hasn't been read in at this stage. 633 ! IF( ntopo == 1 )THEN 634 ! open the file 635 ierr = 0 636 !!$ IF ( ln_zco ) THEN 637 !!$ ! Setting ldstop prevents ctl_stop() from being called if the file 638 !!$ ! doesn't exist 639 !!$ CALL iom_open ( 'bathy_level.nc', inum, ldstop=.FALSE. ) ! Level bathymetry 640 !!$ IF(inum > 0)CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, & 641 !!$ kstart=(/jpizoom,jpjzoom/), & 642 !!$ kcount=(/jpiglo,jpjglo/) ) 643 !!$ ELSE 644 CALL iom_open ( 'bathy_meter.nc', inum, ldstop=.FALSE. ) ! Meter bathy in case of partial steps 645 IF(inum > 0)CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, & 646 kstart=(/jpizoom,jpjzoom/), & 647 kcount=(/jpiglo,jpjglo/) ) 648 !!$ ENDIF 649 IF(inum > 0)THEN 650 CALL iom_close (inum) 651 ELSE 652 ! Flag that an error occurred when reading the file 653 ierr = 1 654 ENDIF 655 ! ELSE 656 ! ! Topography not read from file in this case 657 ! ierr = 1 658 ! END IF 659 660 ! If ln_sco defined then the bathymetry gets smoothed before the 661 ! simulation begins and that process can alter the coastlines 662 ! therefore we do it here too before calculating our mask. 663 ! IF(ln_sco) 664 CALL smooth_bathy(zdta) 665 ! ============================ 666 ! Generate a global mask from the model bathymetry 667 ! ============================ 668 669 ! Read the z-coordinate options from the namelist file 670 REWIND(numnam) 671 READ (numnam, namzgr) 672 673 ! Read domain options from namelist file 674 CALL dom_nam() 675 676 ! Allocate these arrays so we can use domzgr::zgr_z routine; free them at 677 ! when we're done so as not to upset the 'official' allocation once 678 ! the domain decomposition is done. 679 ALLOCATE(gdepw_0(jpk), gdept_0(jpk), e3w_0(jpk), e3t_0(jpk), & 680 ! Need many global, 3D arrays if zgr_zco is to be called 681 !gdepw(jpiglo,jpjglo,jpk), gdept(jpiglo,jpjglo,jpk), & 682 !gdep3w(jpiglo,jpjglo,jpk), e3t(jpiglo,jpjglo,jpk), & 683 mig(jpiglo), mjg(jpjglo), & 684 mbathy(jpiglo,jpjglo), bathy(jpiglo,jpjglo), Stat=ierr) 685 IF(ierr /= 0)THEN 686 CALL ctl_stop('nemo_recursive_partition: failed to allocate zgr_z() arrays') 687 RETURN 688 END IF 689 690 ! Set-up reference depth coordinates 691 CALL zgr_z() 692 693 ! Set-up sub-domain limits as global domain for zgr_bat() 694 nldi = 2 ; nlci = jpiglo - 1 695 nldj = 2 ; nlcj = jpjglo - 1 696 jpi = jpiglo 697 jpj = jpjglo 698 699 ! Set-up fake m{i,j}g arrays for zgr_bat() call 700 DO ii = 1, jpiglo, 1 701 mig(ii) = ii 702 mi0(ii) = ii 703 mi1(ii) = ii 704 END DO 705 DO jj = 1, jpjglo, 1 706 mjg(jj) = jj 707 mj0(jj) = jj 708 mj1(jj) = jj 709 END DO 710 711 ! Initialise closed seas so loop over closed seas in zgr_bat works 712 CALL dom_clo() 713 714 ! Read-in bathy (if required) of global domain 715 CALL zgr_bat(.TRUE.) 665 716 666 717 ! land/sea mask (zero on land, 1 otherwise) over the global/zoom domain 667 718 imask(:,:)=1 668 IF(ierr == 1)THEN 669 ! Failed to read bathymetry so assume all ocean 670 WRITE(*,*) 'ARPDBG: nemo_recursive_partition: no bathymetry file so setting mask to unity' 671 672 ! Mess with otherwise uniform mask to get an irregular decomposition 673 ! for testing ARPDBG 674 CALL generate_fake_land(imask) 675 ELSE 676 ! Comment-out line below to achieve a regular partition 677 WHERE ( zdta(:,:) <= 1.0E-20 ) imask = LAND 719 720 ! Copy bathymetry in case we need to smooth it 721 zdta(:,:) = bathy(:,:) 722 723 IF(ln_sco)THEN 724 ! If ln_sco defined then the bathymetry gets smoothed before the 725 ! simulation begins and that process can alter the coastlines (bug!) 726 ! therefore we do it here too before calculating our mask. 727 CALL smooth_global_bathy(zdta, mbathy) 728 ELSE IF(ln_zps)THEN 729 CALL zgr_zps(.TRUE.) 730 ELSE IF(ln_zco)THEN 731 ! Not certain this is required since mbathy computed in zgr_bat() 732 ! in this case. 733 !CALL zgr_zco() 678 734 END IF 735 736 ! Compute the deepest/last ocean level for every point on the grid 737 ibotlevel(:,:) = mbathy(:,:) 738 CALL global_bot_level(ibotlevel) 739 740 ! Comment-out line below to achieve a regular partition 741 WHERE ( zdta(:,:) <= 1.0E-20 ) imask = LAND 679 742 680 743 ! Allocate partitioning arrays. … … 694 757 695 758 ! Now we can do recursive k-section partitioning 696 ! ARPDBG - BUG if limits on array below are set to anything other than 697 ! 1 and jp{i,j}glo then check for external boundaries in a few lines 698 ! time WILL FAIL! 699 ! CALL partition_rk ( imask, 1, jpiglo, 1, jpjglo, ierr ) 700 701 ! Multi-core aware version of recursive k-section partitioning 759 ! ARPDBG - BUG if limits on array below are set to anything other than 760 ! 1 and jp{i,j}glo then check for external boundaries in a few lines 761 ! time WILL FAIL! 762 ! CALL partition_rk ( imask, 1, jpiglo, 1, jpjglo, ierr ) 763 764 ! Multi-core aware version of recursive k-section partitioning. Currently 765 ! only accounts for whether a grid point is wet or dry. It has no knowledge 766 ! of the number of wet levels at a point. 702 767 CALL partition_mca_rk ( imask, 1, jpiglo, 1, jpjglo, ierr ) 703 768 … … 708 773 ENDIF 709 774 710 ! Set the mask correctly now we've partitioned 775 ! If we used generate_fake_land() above then we must set 776 ! the mask correctly now we've partitioned. This is only 777 ! necessary when testing. 711 778 !WHERE ( zdta(:,:) <= 0. ) imask = 0 712 779 713 ! ARPDBG Quick and dirty dump to stdout in gnuplot form 714 !!$ IF(narea == 1)THEN 715 !!$ OPEN(UNIT=998, FILE="imask.dat", & 716 !!$ STATUS='REPLACE', ACTION='WRITE', IOSTAT=jj) 717 !!$ IF( jj == 0 )THEN 718 !!$ WRITE (998,*) '# Depth map' 719 !!$ DO jj = 1, jpjglo, 1 720 !!$ DO ii = 1, jpiglo, 1 721 !!$ WRITE (998,*) ii, jj, zdta(ii,jj) ! imask(ii,jj) 722 !!$ END DO 723 !!$ WRITE (998,*) 724 !!$ END DO 725 !!$ CLOSE(998) 726 !!$ END IF 727 !!$ END IF 780 ! ARPDBG Quick and dirty dump to stdout in gnuplot form 781 IF(narea == 1)THEN 782 OPEN(UNIT=998, FILE="imask.dat", & 783 STATUS='REPLACE', ACTION='WRITE', IOSTAT=jj) 784 IF( jj == 0 )THEN 785 WRITE (998,*) '# Depth map' 786 WRITE (998,*) '# i j bathy imask ibotlevel mbathy' 787 DO jj = 1, jpjglo, 1 788 DO ii = 1, jpiglo, 1 789 WRITE (998,"(I4,1x,I4,1x,E16.6,1x,I4,1x,I4,1x,I4)") & 790 ii, jj, zdta(ii,jj), imask(ii,jj), ibotlevel(ii,jj), mbathy(ii,jj) 791 END DO 792 WRITE (998,*) 793 END DO 794 CLOSE(998) 795 END IF 796 END IF 728 797 729 798 jpkm1 = jpk - 1 … … 742 811 743 812 #if defined ARPDEBUG 813 ! This output is REQUIRED by the check_nemo_comms.pl test script 744 814 WRITE (*,FMT="(I4,' : ARPDBG: ielb, ieub, iesub = ',3I5)") narea-1,& 745 815 ielb, ieub, iesub … … 758 828 ! false. 759 829 do_exchanges = .TRUE. 830 831 ! Free the domzgr/_oce member arrays that we used earlier in zgr_z() and 832 ! zgr_bat(). 833 DEALLOCATE(gdepw_0, gdept_0, e3w_0, e3t_0, mig, mjg, & 834 mbathy, bathy) 760 835 761 836 END SUBROUTINE nemo_recursive_partition
Note: See TracChangeset
for help on using the changeset viewer.
