Changeset 1200 for trunk/NEMO
- Timestamp:
- 2008-09-24T15:05:20+02:00 (16 years ago)
- Location:
- trunk/NEMO
- Files:
-
- 13 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/NST_SRC/agrif_opa_update.F90
r1156 r1200 95 95 USE wzvmod 96 96 USE cla_div 97 USE ocfzpt98 97 99 98 INTEGER, INTENT(in) :: kt … … 101 100 ta = hdivb 102 101 sa = rotb 103 CALL oc_fz_pt104 102 Call div_cur(kt) 105 103 -
trunk/NEMO/NST_SRC/agrif_user.F90
r1156 r1200 80 80 81 81 REAL(wp) :: tabtemp(jpi,jpj,jpk) 82 #if defined key_ passivetrc82 #if defined key_top 83 83 REAL(wp) :: tabtrtemp(jpi,jpj,jpk,jptra) 84 84 #endif … … 123 123 Call Agrif_Set_type(gcb,(/2,2/),(/3,3/)) 124 124 125 #if defined key_ passivetrc125 #if defined key_top 126 126 Call Agrif_Set_type(trb,(/2,2,0,0/),(/3,3,0,0/)) 127 127 Call Agrif_Set_type(trn,(/2,2,0,0/),(/3,3,0,0/)) … … 152 152 Call Agrif_Set_raf(gcb,(/'x','y'/)) 153 153 154 #if defined key_ passivetrc154 #if defined key_top 155 155 Call Agrif_Set_raf(trb,(/'x','y','N','N'/)) 156 156 Call Agrif_Set_raf(trn,(/'x','y','N','N'/)) … … 175 175 Call Agrif_Set_bcinterp(e2v,interp1=AGRIF_ppm,interp2=Agrif_linear) 176 176 177 #if defined key_ passivetrc177 #if defined key_top 178 178 Call Agrif_Set_bcinterp(trn,interp=AGRIF_linear) 179 179 Call Agrif_Set_bcinterp(tra,interp=AGRIF_linear) … … 197 197 Call Agrif_Set_bc(va,(/-2*Agrif_irhox(),0/)) 198 198 199 #if defined key_ passivetrc199 #if defined key_top 200 200 Call Agrif_Set_bc(trn,(/0,1/)) 201 201 Call Agrif_Set_bc(tra,(/-3*Agrif_irhox(),0/)) … … 213 213 Call Agrif_Set_Updatetype(gcb,update = AGRIF_Update_Average) 214 214 215 #if defined key_ passivetrc215 #if defined key_top 216 216 Call Agrif_Set_Updatetype(trn, update = AGRIF_Update_Average) 217 217 Call Agrif_Set_Updatetype(trb, update = AGRIF_Update_Average) … … 239 239 Call Agrif_Bc_variable(tabtemp,va,calledweight=1.,procname=interpvn) 240 240 241 #if defined key_ passivetrc241 #if defined key_top 242 242 Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.) 243 243 Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.) -
trunk/NEMO/OPA_SRC/DOM/dom_oce.F90
r1161 r1200 188 188 189 189 !!---------------------------------------------------------------------- 190 !! agrif domain 191 !!---------------------------------------------------------------------- 192 #if defined key_agrif 193 LOGICAL, PUBLIC, PARAMETER :: lk_agrif = .TRUE. !: agrif flag 194 #else 195 LOGICAL, PUBLIC, PARAMETER :: lk_agrif = .FALSE. !: agrif flag 196 #endif 197 198 199 !!---------------------------------------------------------------------- 190 200 !! time domain 191 201 !!---------------------------------------------------------------------- -
trunk/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r1158 r1200 141 141 142 142 ! read filtered free surface arrays in restart file 143 CALL flt_rst( nit000, 'READ' ) ! read or initialize the following fields: 144 ! ! gcx, gcxb, sshb, sshn 143 ! when using agrif, sshn, gcx have to be read in istate 144 IF (.NOT. lk_agrif) CALL flt_rst( nit000, 'READ' ) ! read or initialize the following fields: 145 ! ! gcx, gcxb, sshb, sshn 145 146 ENDIF 146 147 -
trunk/NEMO/OPA_SRC/IOM/iom.F90
r1191 r1200 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 llnoov = (jpni * jpnj ) == jpni .AND. .NOT. lk_agrif 106 110 ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix) 107 111 ! ============= 108 112 clname = trim(cdname) 109 113 #if defined key_agrif 110 if ( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 114 IF ( .NOT. Agrif_Root() ) THEN 115 iln = INDEX(clname,'/') 116 cltmpn = clname(1:iln) 117 clname = clname(iln+1:LEN_TRIM(clname)) 118 clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname) 119 ENDIF 111 120 #endif 112 121 ! which suffix should we use? … … 149 158 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 150 159 ! idom = jpdom_local_noovlap ! default definition 151 IF( jpni*jpnj == jpnij) THEN ; idom = jpdom_local_noovlap ! default definition152 ELSE 160 IF( llnoov ) THEN ; idom = jpdom_local_noovlap ! default definition 161 ELSE ; idom = jpdom_local_full ! default definition 153 162 ENDIF 154 163 IF( PRESENT(kdom) ) idom = kdom … … 411 420 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 412 421 ! 422 LOGICAL :: llnoov ! local definition to read overlap 413 423 INTEGER :: jl ! loop on number of dimension 414 424 INTEGER :: idom ! type of domain … … 437 447 ! local definition of the domain ? 438 448 idom = kdom 449 ! do we read the overlap 450 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 451 llnoov = (jpni * jpnj ) == jpni .AND. .NOT. lk_agrif 439 452 ! check kcount and kstart optionals parameters... 440 453 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') … … 520 533 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 521 534 ! IF( idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 522 IF( jpni*jpnj == jpnij.AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)535 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 523 536 ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 524 537 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 525 538 ! icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 526 IF( jpni*jpnj == jpnij) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)527 ELSE 539 IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 540 ELSE ; icnt(1:2) = (/ nlci , nlcj /) 528 541 ENDIF 529 542 IF( PRESENT(pv_r3d) ) THEN … … 558 571 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 559 572 ! ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)' 560 IF( jpni*jpnj == jpnij) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)'561 ELSE 573 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 574 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)' 562 575 ENDIF 563 576 ENDIF … … 565 578 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 566 579 ! ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 567 IF( jpni*jpnj == jpnij) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'568 ELSE 580 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 581 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 569 582 ENDIF 570 583 ENDIF … … 587 600 ! ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 588 601 ! ENDIF 589 IF( jpni*jpnj == jpnij) THEN602 IF( llnoov ) THEN 590 603 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 591 604 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) -
trunk/NEMO/OPA_SRC/SBC/fldread.F90
r1192 r1200 42 42 REAL(wp) , DIMENSION(2) :: rec_b ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year 43 43 REAL(wp) , DIMENSION(2) :: rec_a ! after record (1: index, 2: second since Jan. 1st 00h of nit000 year 44 REAL(wp) , DIMENSION(jpi,jpj) :: fnow ! input fields interpolated to now time step45 REAL(wp) , DIMENSION(jpi,jpj,2) :: fdta ! 2 consecutive record of input fields44 REAL(wp) , ALLOCATABLE, DIMENSION(:,:) :: fnow ! input fields interpolated to now time step 45 REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:) :: fdta ! 2 consecutive record of input fields 46 46 END TYPE FLD 47 47 -
trunk/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r1171 r1200 163 163 CALL ctl_stop( 'sbc_blk_clio: unable to allocate sf structure' ) ; RETURN 164 164 ENDIF 165 166 DO ifpr= 1, jpfld 167 ALLOCATE( sf(ifpr)%fnow(jpi,jpj) ) 168 ALLOCATE( sf(ifpr)%fdta(jpi,jpj,2) ) 169 END DO 170 165 171 166 172 ! fill sf with slf_i and control print -
trunk/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r1156 r1200 108 108 !! 109 109 INTEGER :: ierror ! return error code 110 INTEGER :: ifpr ! dummy loop indice 110 111 !! 111 112 CHARACTER(len=100) :: cn_dir ! Root directory for location of core files … … 149 150 CALL ctl_stop( 'sbc_blk_core: unable to allocate sf structure' ) ; RETURN 150 151 ENDIF 152 153 DO ifpr= 1, jpfld 154 ALLOCATE( sf(ifpr)%fnow(jpi,jpj) ) 155 ALLOCATE( sf(ifpr)%fdta(jpi,jpj,2) ) 156 END DO 151 157 152 158 ! fill sf with slf_i and control print -
trunk/NEMO/OPA_SRC/SBC/sbcflx.F90
r1169 r1200 133 133 CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN 134 134 ENDIF 135 DO ji= 1, jpfld 136 ALLOCATE( sf(ji)%fnow(jpi,jpj) ) 137 ALLOCATE( sf(ji)%fdta(jpi,jpj,2) ) 138 END DO 139 135 140 136 141 ! fill sf with slf_i and control print -
trunk/NEMO/OPA_SRC/SBC/sbcice_if.F90
r1152 r1200 80 80 CALL ctl_stop( 'sbc_ice_if: unable to allocate sf_ice structure' ) ; RETURN 81 81 ENDIF 82 ALLOCATE( sf_ice(1)%fnow(jpi,jpj) ) 83 ALLOCATE( sf_ice(1)%fdta(jpi,jpj,2) ) 84 82 85 83 86 ! fill sf_ice with sn_ice and control print -
trunk/NEMO/OPA_SRC/SBC/sbcrnf.F90
r1164 r1200 152 152 CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' ) ; RETURN 153 153 ENDIF 154 ALLOCATE( sf_rnf(1)%fnow(jpi,jpj) ) 155 ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,2) ) 154 156 155 157 ! fill sf_rnf with sn_rnf and control print -
trunk/NEMO/OPA_SRC/SBC/sbcssr.F90
r1156 r1200 111 111 CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sst structure' ) ; RETURN 112 112 ENDIF 113 ALLOCATE( sf_sst(1)%fnow(jpi,jpj) ) 114 ALLOCATE( sf_sst(1)%fdta(jpi,jpj,2) ) 115 113 116 ! fill sf_sst with sn_sst and control print 114 117 CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' ) … … 122 125 CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sss structure' ) ; RETURN 123 126 ENDIF 127 ALLOCATE( sf_sss(1)%fnow(jpi,jpj) ) 128 ALLOCATE( sf_sss(1)%fdta(jpi,jpj,2) ) 129 124 130 ! fill sf_sss with sn_sss and control print 125 131 CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' ) -
trunk/NEMO/OPA_SRC/istate.F90
r1146 r1200 133 133 ENDIF 134 134 135 IF( lk_vvl ) THEN135 IF( lk_vvl .OR. lk_agrif ) THEN 136 136 ! read free surface arrays in restart file 137 137 IF( ln_rstart ) THEN … … 143 143 ! ! sshb, sshn 144 144 ENDIF 145 ENDIF 146 147 IF( lk_vvl ) THEN 148 145 149 ! 146 150 IF( .NOT. lk_dynspg_flt ) sshbb(:,:) = sshb(:,:)
Note: See TracChangeset
for help on using the changeset viewer.