Changeset 4829 for branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER
- Timestamp:
- 2014-11-05T17:23:08+01:00 (9 years ago)
- Location:
- branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OOO_SRC
- Files:
-
- 2 edited
-
nemogcm.F90 (modified) (17 diffs)
-
ooo_data.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90
r4624 r4829 29 29 !! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 30 30 !! 3.4 ! 2011-11 (C. Harris) decomposition changes for running with CICE 31 !! ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 31 32 !!---------------------------------------------------------------------- 32 33 … … 52 53 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 53 54 USE step ! NEMO time-stepping (stp routine) 54 USE icbini ! handle bergs, initialisation55 USE icbstp ! handle bergs, calving, themodynamics and transport56 55 #if defined key_oasis3 57 56 USE cpl_oasis3 ! OASIS3 coupling … … 63 62 USE xios 64 63 #endif 65 USE ooo_data ! Offline obs_oper data 66 USE ooo_read ! Offline obs_oper read routines 67 USE ooo_intp ! Offline obs_oper interpolation 64 USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges 65 66 ! Offline obs_oper modules 67 USE ooo_data 68 USE ooo_read 69 USE ooo_intp 68 70 69 71 IMPLICIT NONE 70 72 PRIVATE 71 73 72 PUBLIC nemo_gcm ! called by nemo.f9074 PUBLIC nemo_gcm ! called by model.F90 73 75 PUBLIC nemo_init ! needed by AGRIF 74 76 PUBLIC nemo_alloc ! needed by TAM … … 119 121 END SUBROUTINE nemo_gcm 120 122 123 121 124 SUBROUTINE nemo_init 122 125 !!---------------------------------------------------------------------- … … 127 130 INTEGER :: ji ! dummy loop indices 128 131 INTEGER :: ilocal_comm ! local integer 132 INTEGER :: ios 129 133 CHARACTER(len=80), DIMENSION(16) :: cltxt 130 134 !! … … 159 163 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) 160 164 165 ! Force values for AGRIF zoom (cf. agrif_user.F90) 166 #if defined key_agrif 167 IF( .NOT. Agrif_Root() ) THEN 168 jpiglo = nbcellsx + 2 + 2*nbghostcells 169 jpjglo = nbcellsy + 2 + 2*nbghostcells 170 jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 171 jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 172 jpidta = jpiglo 173 jpjdta = jpjglo 174 jpizoom = 1 175 jpjzoom = 1 176 nperio = 0 177 jperio = 0 178 ENDIF 179 #endif 180 ! 161 181 ! !--------------------------------------------! 162 182 ! ! set communicator & select the local node ! … … 182 202 # else 183 203 ilocal_comm = 0 184 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt)204 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 185 205 # endif 186 206 #endif … … 221 241 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 222 242 #endif 243 ENDIF 223 244 jpk = jpkdta ! third dim 224 245 jpim1 = jpi-1 ! inner domain indices … … 226 247 jpkm1 = jpk-1 ! " " 227 248 jpij = jpi*jpj ! jpi x j 228 ENDIF229 249 230 250 IF(lwp) THEN ! open listing units … … 275 295 CALL istate_init ! ocean initial state (Dynamics and tracers) 276 296 297 ! 277 298 IF( lk_diaobs ) THEN ! Observation & model comparison 278 299 CALL dia_obs_init ! Initialize observational data … … 316 337 jsplt = nn_jsplt 317 338 nbench = nn_bench 339 340 IF(lwp) THEN ! control print 341 WRITE(numout,*) 342 WRITE(numout,*) 'namcfg : configuration initialization through namelist read' 343 WRITE(numout,*) '~~~~~~~ ' 344 WRITE(numout,*) ' Namelist namcfg' 345 WRITE(numout,*) ' configuration name cp_cfg = ', TRIM(cp_cfg) 346 WRITE(numout,*) ' configuration zoom name cp_cfz = ', TRIM(cp_cfz) 347 WRITE(numout,*) ' configuration resolution jp_cfg = ', jp_cfg 348 WRITE(numout,*) ' 1st lateral dimension ( >= jpi ) jpidta = ', jpidta 349 WRITE(numout,*) ' 2nd " " ( >= jpj ) jpjdta = ', jpjdta 350 WRITE(numout,*) ' 3nd " " jpkdta = ', jpkdta 351 WRITE(numout,*) ' 1st dimension of global domain in i jpiglo = ', jpiglo 352 WRITE(numout,*) ' 2nd - - in j jpjglo = ', jpjglo 353 WRITE(numout,*) ' left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom 354 WRITE(numout,*) ' left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 355 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio 356 ENDIF 318 357 ! ! Parameter control 319 358 ! … … 359 398 CASE ( 'gyre' ) ; CALL ctl_warn( ' The Benchmark is activated ' ) 360 399 CASE DEFAULT ; CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:', & 361 & ' key_gyre must be usedor set nbench = 0' )400 & ' cp_cfg = "gyre" in namelist &namcfg or set nbench = 0' ) 362 401 END SELECT 363 402 ENDIF 364 !365 IF( lk_c1d .AND. .NOT.lk_iomput ) CALL ctl_stop( 'nemo_ctl: The 1D configuration must be used ', &366 & 'with the IOM Input/Output manager. ' , &367 & 'Compile with key_iomput enabled' )368 403 ! 369 404 IF( 1_wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ', & … … 385 420 CALL iom_close ! close all input/output files managed by iom_* 386 421 ! 387 IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file 388 IF( numsol /= -1 ) CLOSE( numsol ) ! solver file 389 IF( numnam /= -1 ) CLOSE( numnam ) ! oce namelist 390 IF( numnam_ice /= -1 ) CLOSE( numnam_ice ) ! ice namelist 391 IF( numevo_ice /= -1 ) CLOSE( numevo_ice ) ! ice variables (temp. evolution) 392 IF( numout /= 6 ) CLOSE( numout ) ! standard model output file 393 IF( numdct_vol /= -1 ) CLOSE( numdct_vol ) ! volume transports 394 IF( numdct_heat /= -1 ) CLOSE( numdct_heat ) ! heat transports 395 IF( numdct_salt /= -1 ) CLOSE( numdct_salt ) ! salt transports 422 IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file 423 IF( numsol /= -1 ) CLOSE( numsol ) ! solver file 424 IF( numnam_ref /= -1 ) CLOSE( numnam_ref ) ! oce reference namelist 425 IF( numnam_cfg /= -1 ) CLOSE( numnam_cfg ) ! oce configuration namelist 426 IF( lwm.AND.numond /= -1 ) CLOSE( numond ) ! oce output namelist 427 IF( numnam_ice_ref /= -1 ) CLOSE( numnam_ice_ref ) ! ice reference namelist 428 IF( numnam_ice_cfg /= -1 ) CLOSE( numnam_ice_cfg ) ! ice configuration namelist 429 IF( lwm.AND.numoni /= -1 ) CLOSE( numoni ) ! ice output namelist 430 IF( numevo_ice /= -1 ) CLOSE( numevo_ice ) ! ice variables (temp. evolution) 431 IF( numout /= 6 ) CLOSE( numout ) ! standard model output file 432 IF( numdct_vol /= -1 ) CLOSE( numdct_vol ) ! volume transports 433 IF( numdct_heat /= -1 ) CLOSE( numdct_heat ) ! heat transports 434 IF( numdct_salt /= -1 ) CLOSE( numdct_salt ) ! salt transports 396 435 397 436 ! … … 418 457 ierr = ierr + dia_wri_alloc () 419 458 ierr = ierr + dom_oce_alloc () ! ocean domain 420 !421 ierr = ierr + lib_mpp_alloc (numout) ! mpp exchanges422 459 ! 423 460 IF( lk_mpp ) CALL mpp_sum( ierr ) … … 544 581 !!====================================================================== 545 582 !! *** ROUTINE nemo_northcomms *** 546 !! nemo_northcomms : Setup for north fold exchanges with explicit peer to peer messaging 583 !! nemo_northcomms : Setup for north fold exchanges with explicit 584 !! point-to-point messaging 547 585 !!===================================================================== 548 586 !!---------------------------------------------------------------------- … … 551 589 !!---------------------------------------------------------------------- 552 590 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 553 !!---------------------------------------------------------------------- 554 555 INTEGER :: ji, jj, jk, ij, jtyp ! dummy loop indices 556 INTEGER :: ijpj ! number of rows involved in north-fold exchange 557 INTEGER :: northcomms_alloc ! allocate return status 558 REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) :: znnbrs ! workspace 559 LOGICAL, ALLOCATABLE, DIMENSION ( : ) :: lrankset ! workspace 560 561 IF(lwp) WRITE(numout,*) 562 IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists' 563 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 564 565 !!---------------------------------------------------------------------- 566 ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc ) 567 ALLOCATE( lrankset(jpnij), stat = northcomms_alloc ) 568 IF( northcomms_alloc /= 0 ) THEN 569 WRITE(numout,cform_war) 570 WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays' 571 CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' ) 572 ENDIF 591 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 592 !!---------------------------------------------------------------------- 593 594 INTEGER :: sxM, dxM, sxT, dxT, jn 595 INTEGER :: njmppmax 596 597 njmppmax = MAXVAL( njmppt ) 598 599 !initializes the north-fold communication variables 600 isendto(:) = 0 573 601 nsndto = 0 574 isendto = -1 575 ijpj = 4 576 ! 577 ! This routine has been called because ln_nnogather has been set true ( nammpp ) 578 ! However, these first few exchanges have to use the mpi_allgather method to 579 ! establish the neighbour lists to use in subsequent peer to peer exchanges. 580 ! Consequently, set l_north_nogather to be false here and set it true only after 581 ! the lists have been established. 582 ! 583 l_north_nogather = .FALSE. 584 ! 585 ! Exchange and store ranks on northern rows 586 587 DO jtyp = 1,4 588 589 lrankset = .FALSE. 590 znnbrs = narea 591 SELECT CASE (jtyp) 592 CASE(1) 593 CALL lbc_lnk( znnbrs, 'T', 1. ) ! Type 1: T,W-points 594 CASE(2) 595 CALL lbc_lnk( znnbrs, 'U', 1. ) ! Type 2: U-point 596 CASE(3) 597 CALL lbc_lnk( znnbrs, 'V', 1. ) ! Type 3: V-point 598 CASE(4) 599 CALL lbc_lnk( znnbrs, 'F', 1. ) ! Type 4: F-point 600 END SELECT 601 602 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 603 DO jj = nlcj-ijpj+1, nlcj 604 ij = jj - nlcj + ijpj 605 DO ji = 1,jpi 606 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 607 & lrankset(INT(znnbrs(ji,jj))) = .true. 608 END DO 609 END DO 610 611 DO jj = 1,jpnij 612 IF ( lrankset(jj) ) THEN 613 nsndto(jtyp) = nsndto(jtyp) + 1 614 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 615 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 616 & ' jpmaxngh will need to be increased ') 617 ENDIF 618 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 619 ENDIF 620 END DO 621 ENDIF 622 623 END DO 624 625 ! 626 ! Type 5: I-point 627 ! 628 ! ICE point exchanges may involve some averaging. The neighbours list is 629 ! built up using two exchanges to ensure that the whole stencil is covered. 630 ! lrankset should not be reset between these 'J' and 'K' point exchanges 631 632 jtyp = 5 633 lrankset = .FALSE. 634 znnbrs = narea 635 CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point 636 637 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 638 DO jj = nlcj-ijpj+1, nlcj 639 ij = jj - nlcj + ijpj 640 DO ji = 1,jpi 641 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 642 & lrankset(INT(znnbrs(ji,jj))) = .true. 643 END DO 644 END DO 645 ENDIF 646 647 znnbrs = narea 648 CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point 649 650 IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN 651 DO jj = nlcj-ijpj+1, nlcj 652 ij = jj - nlcj + ijpj 653 DO ji = 1,jpi 654 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 655 & lrankset( INT(znnbrs(ji,jj))) = .true. 656 END DO 657 END DO 658 659 DO jj = 1,jpnij 660 IF ( lrankset(jj) ) THEN 661 nsndto(jtyp) = nsndto(jtyp) + 1 662 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 663 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 664 & ' jpmaxngh will need to be increased ') 665 ENDIF 666 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 667 ENDIF 668 END DO 669 ! 670 ! For northern row areas, set l_north_nogather so that all subsequent exchanges 671 ! can use peer to peer communications at the north fold 672 ! 673 l_north_nogather = .TRUE. 674 ! 675 ENDIF 676 DEALLOCATE( znnbrs ) 677 DEALLOCATE( lrankset ) 678 602 603 !if I am a process in the north 604 IF ( njmpp == njmppmax ) THEN 605 !sxM is the first point (in the global domain) needed to compute the 606 !north-fold for the current process 607 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 608 !dxM is the last point (in the global domain) needed to compute the 609 !north-fold for the current process 610 dxM = jpiglo - nimppt(narea) + 2 611 612 !loop over the other north-fold processes to find the processes 613 !managing the points belonging to the sxT-dxT range 614 DO jn = jpnij - jpni +1, jpnij 615 IF ( njmppt(jn) == njmppmax ) THEN 616 !sxT is the first point (in the global domain) of the jn 617 !process 618 sxT = nimppt(jn) 619 !dxT is the last point (in the global domain) of the jn 620 !process 621 dxT = nimppt(jn) + nlcit(jn) - 1 622 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 623 nsndto = nsndto + 1 624 isendto(nsndto) = jn 625 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 626 nsndto = nsndto + 1 627 isendto(nsndto) = jn 628 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 629 nsndto = nsndto + 1 630 isendto(nsndto) = jn 631 END IF 632 END IF 633 END DO 634 ENDIF 635 l_north_nogather = .TRUE. 679 636 END SUBROUTINE nemo_northcomms 680 637 #else … … 685 642 !!====================================================================== 686 643 END MODULE nemogcm 644 645 -
branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OOO_SRC/ooo_data.F90
r4132 r4829 85 85 86 86 ! Standard offline obs_oper settings 87 READ(numnam , namooo)87 READ(numnam_ref, namooo) 88 88 89 89 ! Read class 4 output settings 90 90 IF (ld_cl4) THEN 91 READ(numnam , namcl4)91 READ(numnam_ref, namcl4) 92 92 ENDIF 93 93
Note: See TracChangeset
for help on using the changeset viewer.
