Changeset 3658


Ignore:
Timestamp:
2012-11-26T14:08:30+01:00 (8 years ago)
Author:
pabouttier
Message:

Missing allocation for sbcssr_tam variables - see Ticket #1022

Location:
branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/SBC/sbcssr_tam.F90

    r3611 r3658  
    3636   PUBLIC   sbc_ssr_tan    ! routine called in sbcmod_tam 
    3737   PUBLIC   sbc_ssr_adj    ! routine called in sbcmod_tam 
     38   PUBLIC   sbc_ssr_ini_tam    ! routine called in sbcmod_tam 
    3839   PUBLIC   sbc_ssr_adj_tst! routine called in tst 
    3940 
     
    8889      ! 
    8990      !                                               ! -------------------- ! 
    90       IF( kt == nit000 ) THEN                         ! First call kt=nit000 ! 
    91          !                                            ! -------------------- ! 
    92          ! Allocate erp and qrp array 
    93          ALLOCATE( qrp_tl(jpi,jpj), erp_tl(jpi,jpj), STAT=ierror ) 
    94          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' ) 
    95          CALL sbc_ssr_ini_tam ( 0 ) 
    96       ENDIF 
     91      !IF( kt == nit000 ) THEN                         ! First call kt=nit000 ! 
     92         !!                                            ! -------------------- ! 
     93         !! Allocate erp and qrp array 
     94         !ALLOCATE( qrp_tl(jpi,jpj), erp_tl(jpi,jpj), STAT=ierror ) 
     95         !IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' ) 
     96         !CALL sbc_ssr_ini_tam ( 0 ) 
     97      !ENDIF 
    9798 
    9899      IF( nn_sstr + nn_sssr /= 0 ) THEN 
     
    150151      zqrpad = 0.0 
    151152      !                                               ! -------------------- ! 
    152       IF( kt == nit000 ) THEN                         ! First call kt=nit000 ! 
    153          !                                            ! -------------------- ! 
    154          ! Allocate erp and qrp array 
    155          ALLOCATE( qrp_ad(jpi,jpj), erp_ad(jpi,jpj), STAT=ierror ) 
    156          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' ) 
    157          CALL sbc_ssr_ini_tam ( 1 ) 
    158       ENDIF 
     153      !IF( kt == nit000 ) THEN                         ! First call kt=nit000 ! 
     154         !!                                            ! -------------------- ! 
     155         !! Allocate erp and qrp array 
     156         !ALLOCATE( qrp_ad(jpi,jpj), erp_ad(jpi,jpj), STAT=ierror ) 
     157         !IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' ) 
     158         !CALL sbc_ssr_ini_tam ( 1 ) 
     159      !ENDIF 
    159160 
    160161      IF( nn_sstr + nn_sssr /= 0 ) THEN 
     
    346347   END SUBROUTINE sbc_ssr_adj_tst 
    347348 
    348  
    349    SUBROUTINE sbc_ssr_ini_tam( kindic ) 
     349   SUBROUTINE sbc_ssr_ini_tam 
    350350      USE fldread 
     351      INTEGER :: ierror 
    351352      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
    352353      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read 
    353354      !!---------------------------------------------------------------------- 
    354       INTEGER, INTENT(IN) :: kindic 
    355355      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, & 
    356356         &                 sn_sss, ln_sssr_bnd, rn_sssr_bnd 
     
    369369         WRITE(numout,*) '          dE/dS (restoring magnitude on SST)     deds    = ', rn_deds, ' mm/day' 
    370370      ENDIF 
     371         ALLOCATE( qrp_ad(jpi,jpj), erp_ad(jpi,jpj), & 
     372            &      qrp_tl(jpi,jpj), erp_tl(jpi,jpj), STAT=ierror ) 
     373         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' ) 
    371374 
    372375      ! 
    373376      ! Initialize qrp and erp if no restoring 
    374       IF ( kindic == 0 ) THEN 
    375          qrp_tl(:,:) = 0.e0 
    376          erp_tl(:,:) = 0.e0 
    377       ELSEIF ( kindic == 1 ) THEN 
    378          qrp_ad(:,:) = 0.e0 
    379          erp_ad(:,:) = 0.e0 
    380       END IF 
     377      qrp_tl(:,:) = 0.e0 
     378      erp_tl(:,:) = 0.e0 
     379      qrp_ad(:,:) = 0.e0 
     380      erp_ad(:,:) = 0.e0 
    381381   END SUBROUTINE sbc_ssr_ini_tam 
    382382 
  • branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/TRA/zpshde_tam.F90

    r3611 r3658  
    149149                  ! interpolated values of T and S 
    150150                  zti(ji,jj,jn) = pta(ji+1,jj,iku,jn)            & 
    151                      &       + zmaxu * ( pta(ji+1,jj,iku-1,jn) - pta(ji+1,jj,iku,jn) ) 
     151                     &       + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 
    152152                  ztitl(ji,jj,jn) = pta_tl(ji+1,jj,iku,jn)       & 
    153153                     &         + zmaxu * ( pta_tl(ji+1,jj,iku-1,jn) - pta_tl(ji+1,jj,iku,jn) ) 
     
    158158                  ! interpolated values of T and S 
    159159                  zti(ji,jj,jn) = pta(ji,jj,iku,jn)              & 
    160                      &       + zmaxu * ( pta(ji,jj,iku-1,jn) - pta(ji,jj,iku,jn) ) 
     160                     &       + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 
    161161                  ! interpolated values of T and S 
    162162                  ztitl(ji,jj,jn) = pta_tl(ji,jj,iku,jn)         & 
    163                      &         + zmaxu * ( pta_tl(ji,jj,iku-1,jn) - pta_tl(ji,jj,iku,jn) ) 
     163                     &         + zmaxu * ( pta_tl(ji,jj,ikum1,jn) - pta_tl(ji,jj,iku,jn) ) 
    164164                  ! gradient of T and S 
    165165                  pgtu_tl(ji,jj,jn) = umask(ji,jj,1) * ( pta_tl(ji+1,jj,iku,jn) - ztitl (ji,jj,jn) ) 
  • branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/nemogcm_tam.F90

    r3641 r3658  
    8181   USE nemogcm 
    8282   USE step_tam 
     83   USE sbcssr_tam 
    8384   USE step_oce_tam 
    8485   USE zdf_oce_tam 
     
    341342      !                                     ! Ocean physics 
    342343                            CALL     sbc_init_tam   ! Forcings : surface module 
     344                            CALL     sbc_ssr_ini_tam   ! Forcings : surface module 
    343345      !                                         ! Vertical physics 
    344346      !                      CALL     zdf_init_tam      ! namelist read 
  • branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/step_tam.F90

    r3641 r3658  
    461461         & ztn_adin ,        & ! Adjoint input 
    462462         & zsn_adin ,        & ! Adjoint input 
    463 #if defined key_obc 
    464          & zub_adin ,        & ! Adjoint input 
    465          & zvb_adin ,        & ! Adjoint input 
    466          & ztb_adin ,        & ! Adjoint input 
    467          & zsb_adin ,        & ! Adjoint input 
    468          & zub_tlout ,        & ! Adjoint input 
    469          & zvb_tlout ,        & ! Adjoint input 
    470          & ztb_tlout ,        & ! Adjoint input 
    471          & zsb_tlout ,        & ! Adjoint input 
    472 #endif 
    473463         & zun_adout,        & ! Adjoint output 
    474464         & zvn_adout,        & ! Adjoint output 
     
    481471         & zsshn_adin  ,     & ! Adjoint output 
    482472         & zsshn_adout ,     & ! Adjoint output 
    483 #if defined key_obc 
    484          & zsshb_tlout ,     & ! Tangent input 
    485          & zsshb_adin  ,     & ! Tangent input 
    486 #endif 
    487473         & z2r                 ! 2D random field 
    488474 
     
    507493         & ) 
    508494 
    509 #if defined key_obc 
    510       ALLOCATE( zub_adin   (jpi,jpj,jpk), zvb_adin  (jpi,jpj,jpk) ,        & 
    511            &    ztb_adin   (jpi,jpj,jpk), zsb_adin  (jpi,jpj,jpk) ,        & 
    512            &    zub_tlout  (jpi,jpj,jpk), zvb_tlout (jpi,jpj,jpk) ,        & 
    513            &    ztb_tlout  (jpi,jpj,jpk), zsb_tlout (jpi,jpj,jpk) ,        & 
    514            &    zsshb_tlout(jpi,jpj)    , zsshb_adin(jpi,jpj)       ) 
    515 #endif 
    516495      !================================================================== 
    517496      ! 1) dx = ( un_tl, vn_tl, tn_tl, sn_tl, sshn_tl ) and 
     
    630609            sshn_tl(  :,:) = zsshn_tlin (  :,:) 
    631610 
    632 #if defined key_pomme_r025 
    633             IF ( (jpert == 5) .OR. (jpert == jpertmax) ) THEN 
    634                !DO ji = 1, jpi 
    635                !   DO jj = 1, jpj 
    636                !      sshn_tl(ji,jj) = cos( (2.*rpi)*(FLOAT(ji)-0.5)/FLOAT(jpi) + rpi/2. ) & 
    637                !                     * sin( (2.*rpi)*(FLOAT(jj)-0.5)/FLOAT(jpj) ) / 100. 
    638                !   END DO 
    639                !END DO 
    640  
    641                DO ji = 1, jpi 
    642                   DO jj = 1, jpj 
    643                      zsshn_tlin(ji,jj) = exp( -((float(ji)-float(jpi)/2.)/(float(jpi)/5.))**2 & 
    644                           -((float(jj)-float(jpj)/2.)/(float(jpj)/5.))**2 ) / 100. & 
    645                           * tmask(ji,jj,1) 
    646                   END DO 
    647                END DO 
    648                sshn_tl(:,:) = zsshn_tlin(:,:) 
    649             ENDIF 
    650 #endif 
    651  
    652611            !CALL     oce_tam_deallocate( 2 )    ! deallocate adj variables 
    653612            !CALL sbc_oce_tam_deallocate( 2 ) 
     
    669628            zsn_tlout  ( :,:,:) = tsn_tl   (:,:,:,jp_sal) 
    670629            zsshn_tlout(   :,:) = sshn_tl (  :,:) 
    671  
    672 #if defined key_obc 
    673             zub_tlout  (:,:,:) = ub_tl  (:,:,:) 
    674             zvb_tlout  (:,:,:) = vb_tl  (:,:,:) 
    675             ztb_tlout  (:,:,:) = tsb_tl  (:,:,:,jp_tem) 
    676             zsb_tlout  (:,:,:) = tsb_tl  (:,:,:,jp_sal) 
    677             zsshb_tlout(:,:)   = sshb_tl(:,:) 
    678 #endif 
    679630 
    680631            !-------------------------------------------------------------------- 
     
    688639                          &               * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) & 
    689640                          &               * umask(ji,jj,jk) * wesp_u 
    690 #if defined key_obc 
    691                      zub_adin(ji,jj,jk) = zub_tlout(ji,jj,jk) & 
    692                           &               * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) & 
    693                           &               * umask(ji,jj,jk) * wesp_u 
    694 #endif 
    695641                  END DO 
    696642               END DO 
     
    703649                          &               * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) & 
    704650                          &               * vmask(ji,jj,jk) * wesp_u 
    705 #if defined key_obc 
    706                      zvb_adin(ji,jj,jk) = zvb_tlout(ji,jj,jk) & 
    707                           &               * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) & 
    708                           &               * vmask(ji,jj,jk) * wesp_u 
    709 #endif 
    710651                  END DO 
    711652               END DO 
     
    718659                          &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) & 
    719660                          &               * tmask(ji,jj,jk) * wesp_t(jk) 
    720 #if defined key_obc 
    721                      ztb_adin(ji,jj,jk) = ztb_tlout(ji,jj,jk) & 
    722                           &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) & 
    723                           &               * tmask(ji,jj,jk) * wesp_t(jk) 
    724 #endif 
    725661                  END DO 
    726662               END DO 
     
    733669                          &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) & 
    734670                          &               * tmask(ji,jj,jk) * wesp_s(jk) 
    735 #if defined key_obc 
    736                      zsb_adin(ji,jj,jk) = zsb_tlout(ji,jj,jk) & 
    737                           &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) & 
    738                           &               * tmask(ji,jj,jk) * wesp_s(jk) 
    739 #endif 
    740671                  END DO 
    741672               END DO 
     
    747678                       &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) & 
    748679                       &               * tmask(ji,jj,1) * wesp_ssh 
    749 #if defined key_obc 
    750                   zsshb_adin(ji,jj) = zsshb_tlout(ji,jj) & 
    751                        &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) & 
    752                        &               * tmask(ji,jj,1) * wesp_ssh 
    753 #endif 
    754680               END DO 
    755681            END DO 
     
    767693            zsp1      = zsp1_U + zsp1_V + zsp1_T + zsp1_S + zsp1_SSH 
    768694 
    769 #if defined key_obc 
    770             zsp1_U    = DOT_PRODUCT( zub_tlout  , zub_adin    ) 
    771             zsp1_V    = DOT_PRODUCT( zvb_tlout  , zvb_adin    ) 
    772             zsp1_T    = DOT_PRODUCT( ztb_tlout  , ztb_adin    ) 
    773             zsp1_S    = DOT_PRODUCT( zsb_tlout  , zsb_adin    ) 
    774             zsp1_SSH  = DOT_PRODUCT( zsshb_tlout, zsshb_adin  ) 
    775  
    776             zsp1      = zsp1 + ( zsp1_U + zsp1_V + zsp1_T + zsp1_S + zsp1_SSH ) 
    777 #endif 
    778695            !-------------------------------------------------------------------- 
    779696            ! Call the adjoint routine: dx^* = L^T dy^* 
     
    798715            tsn_ad  (:,:,:,jp_sal) = zsn_adin   (:,:,:) 
    799716            sshn_ad(  :,:) = zsshn_adin (  :,:) 
    800  
    801 #if defined key_obc 
    802             ub_ad  (:,:,:) = zub_adin   (:,:,:) 
    803             vb_ad  (:,:,:) = zvb_adin   (:,:,:) 
    804             tsb_ad  (:,:,:,jp_tem) = ztb_adin   (:,:,:) 
    805             tsb_ad  (:,:,:,jp_sal) = zsb_adin   (:,:,:) 
    806             sshb_ad(:,:)   = zsshb_adin (:,:) 
    807 #endif 
    808717 
    809718            !CALL     oce_tam_deallocate( 1 )    !deallocate tl variables 
  • branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/tamtst.F90

    r3611 r3658  
    129129 
    130130      ! Initialize energy weights 
    131  
    132131      CALL par_esp 
    133132 
Note: See TracChangeset for help on using the changeset viewer.