Changeset 1324 for trunk/NEMO/OFF_SRC/IOM/iom.F90
- Timestamp:
- 2009-02-20T11:00:03+01:00 (15 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OFF_SRC/IOM/iom.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OFF_SRC/IOM/iom.F90
r1152 r1324 69 69 LOGICAL :: llok ! check the existence 70 70 LOGICAL :: llwrt ! local definition of ldwrt 71 LOGICAL :: llnoov ! local definition to read overlap 71 72 LOGICAL :: llstop ! local definition of ldstop 72 73 INTEGER :: iolib ! library do we use to open the file … … 104 105 ELSE ; iolib = jpnf90 105 106 ENDIF 107 ! do we read the overlap 108 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 109 #if ! defined key_agrif 110 llnoov = (jpni * jpnj ) == jpnij 111 #endif 106 112 ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix) 107 113 ! ============= 108 114 clname = trim(cdname) 109 115 #if defined key_agrif 110 if ( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 116 IF ( .NOT. Agrif_Root() ) THEN 117 iln = INDEX(clname,'/') 118 cltmpn = clname(1:iln) 119 clname = clname(iln+1:LEN_TRIM(clname)) 120 clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname) 121 ENDIF 111 122 #endif 112 123 ! which suffix should we use? … … 149 160 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 150 161 ! idom = jpdom_local_noovlap ! default definition 151 IF( jpni*jpnj == jpnij) THEN ; idom = jpdom_local_noovlap ! default definition152 ELSE 162 IF( llnoov ) THEN ; idom = jpdom_local_noovlap ! default definition 163 ELSE ; idom = jpdom_local_full ! default definition 153 164 ENDIF 154 165 IF( PRESENT(kdom) ) idom = kdom … … 212 223 !! ** Purpose : close an input file, or all files opened by iom 213 224 !!-------------------------------------------------------------------- 214 INTEGER, INTENT(in), OPTIONAL :: kiomid ! iom identifier of the file to be closed 215 ! ! No argument : all the files opened by iom are closed 225 INTEGER, INTENT(inout), OPTIONAL :: kiomid ! iom identifier of the file to be closed 226 ! ! return 0 when file is properly closed 227 ! ! No argument: all files opened by iom are closed 216 228 217 229 INTEGER :: jf ! dummy loop indices … … 239 251 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 240 252 END SELECT 241 iom_file(jf)%nfid = 0 ! free the id 253 iom_file(jf)%nfid = 0 ! free the id 254 IF( PRESENT(kiomid) ) kiomid = 0 ! return 0 as id to specify that the file was closed 242 255 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok' 243 256 ELSEIF( PRESENT(kiomid) ) THEN … … 409 422 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 410 423 ! 424 LOGICAL :: llnoov ! local definition to read overlap 411 425 INTEGER :: jl ! loop on number of dimension 412 426 INTEGER :: idom ! type of domain … … 435 449 ! local definition of the domain ? 436 450 idom = kdom 451 ! do we read the overlap 452 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 453 #if ! defined key_agrif 454 llnoov = (jpni * jpnj ) == jpnij 455 #endif 437 456 ! check kcount and kstart optionals parameters... 438 457 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') … … 518 537 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 519 538 ! IF( idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 520 IF( jpni*jpnj == jpnij.AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)539 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 521 540 ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 522 541 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 523 542 ! icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 524 IF( jpni*jpnj == jpnij) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)525 ELSE 543 IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 544 ELSE ; icnt(1:2) = (/ nlci , nlcj /) 526 545 ENDIF 527 546 IF( PRESENT(pv_r3d) ) THEN … … 556 575 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 557 576 ! ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)' 558 IF( jpni*jpnj == jpnij) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)'559 ELSE 577 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 578 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)' 560 579 ENDIF 561 580 ENDIF … … 563 582 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 564 583 ! ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 565 IF( jpni*jpnj == jpnij) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'566 ELSE 584 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 585 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 567 586 ENDIF 568 587 ENDIF … … 585 604 ! ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 586 605 ! ENDIF 587 IF( jpni*jpnj == jpnij) THEN606 IF( llnoov ) THEN 588 607 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 589 608 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) … … 607 626 608 627 IF( istop == nstop ) THEN ! no additional errors until this point... 609 IF(lwp) WRITE(numout, *) ' read '//TRIM(cdvar)//' in '//TRIM(iom_file(kiomid)%name)//' ok'610 628 IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i4,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 629 611 630 !--- overlap areas and extra hallows (mpp) 612 631 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
