Changeset 3658
- Timestamp:
- 2012-11-26T14:08:30+01:00 (12 years ago)
- Location:
- branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC
- Files:
-
- 5 edited
-
SBC/sbcssr_tam.F90 (modified) (5 diffs)
-
TRA/zpshde_tam.F90 (modified) (2 diffs)
-
nemogcm_tam.F90 (modified) (2 diffs)
-
step_tam.F90 (modified) (12 diffs)
-
tamtst.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/SBC/sbcssr_tam.F90
r3611 r3658 36 36 PUBLIC sbc_ssr_tan ! routine called in sbcmod_tam 37 37 PUBLIC sbc_ssr_adj ! routine called in sbcmod_tam 38 PUBLIC sbc_ssr_ini_tam ! routine called in sbcmod_tam 38 39 PUBLIC sbc_ssr_adj_tst! routine called in tst 39 40 … … 88 89 ! 89 90 ! ! -------------------- ! 90 IF( kt == nit000 ) THEN ! First call kt=nit000 !91 ! ! -------------------- !92 ! Allocate erp and qrp array93 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 ENDIF91 !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 97 98 98 99 IF( nn_sstr + nn_sssr /= 0 ) THEN … … 150 151 zqrpad = 0.0 151 152 ! ! -------------------- ! 152 IF( kt == nit000 ) THEN ! First call kt=nit000 !153 ! ! -------------------- !154 ! Allocate erp and qrp array155 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 ENDIF153 !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 159 160 160 161 IF( nn_sstr + nn_sssr /= 0 ) THEN … … 346 347 END SUBROUTINE sbc_ssr_adj_tst 347 348 348 349 SUBROUTINE sbc_ssr_ini_tam( kindic ) 349 SUBROUTINE sbc_ssr_ini_tam 350 350 USE fldread 351 INTEGER :: ierror 351 352 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 352 353 TYPE(FLD_N) :: sn_sst, sn_sss ! informations about the fields to be read 353 354 !!---------------------------------------------------------------------- 354 INTEGER, INTENT(IN) :: kindic355 355 NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, & 356 356 & sn_sss, ln_sssr_bnd, rn_sssr_bnd … … 369 369 WRITE(numout,*) ' dE/dS (restoring magnitude on SST) deds = ', rn_deds, ' mm/day' 370 370 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' ) 371 374 372 375 ! 373 376 ! 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 381 381 END SUBROUTINE sbc_ssr_ini_tam 382 382 -
branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/TRA/zpshde_tam.F90
r3611 r3658 149 149 ! interpolated values of T and S 150 150 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) ) 152 152 ztitl(ji,jj,jn) = pta_tl(ji+1,jj,iku,jn) & 153 153 & + zmaxu * ( pta_tl(ji+1,jj,iku-1,jn) - pta_tl(ji+1,jj,iku,jn) ) … … 158 158 ! interpolated values of T and S 159 159 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) ) 161 161 ! interpolated values of T and S 162 162 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) ) 164 164 ! gradient of T and S 165 165 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 81 81 USE nemogcm 82 82 USE step_tam 83 USE sbcssr_tam 83 84 USE step_oce_tam 84 85 USE zdf_oce_tam … … 341 342 ! ! Ocean physics 342 343 CALL sbc_init_tam ! Forcings : surface module 344 CALL sbc_ssr_ini_tam ! Forcings : surface module 343 345 ! ! Vertical physics 344 346 ! CALL zdf_init_tam ! namelist read -
branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/step_tam.F90
r3641 r3658 461 461 & ztn_adin , & ! Adjoint input 462 462 & zsn_adin , & ! Adjoint input 463 #if defined key_obc464 & zub_adin , & ! Adjoint input465 & zvb_adin , & ! Adjoint input466 & ztb_adin , & ! Adjoint input467 & zsb_adin , & ! Adjoint input468 & zub_tlout , & ! Adjoint input469 & zvb_tlout , & ! Adjoint input470 & ztb_tlout , & ! Adjoint input471 & zsb_tlout , & ! Adjoint input472 #endif473 463 & zun_adout, & ! Adjoint output 474 464 & zvn_adout, & ! Adjoint output … … 481 471 & zsshn_adin , & ! Adjoint output 482 472 & zsshn_adout , & ! Adjoint output 483 #if defined key_obc484 & zsshb_tlout , & ! Tangent input485 & zsshb_adin , & ! Tangent input486 #endif487 473 & z2r ! 2D random field 488 474 … … 507 493 & ) 508 494 509 #if defined key_obc510 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 #endif516 495 !================================================================== 517 496 ! 1) dx = ( un_tl, vn_tl, tn_tl, sn_tl, sshn_tl ) and … … 630 609 sshn_tl( :,:) = zsshn_tlin ( :,:) 631 610 632 #if defined key_pomme_r025633 IF ( (jpert == 5) .OR. (jpert == jpertmax) ) THEN634 !DO ji = 1, jpi635 ! DO jj = 1, jpj636 ! 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 DO639 !END DO640 641 DO ji = 1, jpi642 DO jj = 1, jpj643 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 DO647 END DO648 sshn_tl(:,:) = zsshn_tlin(:,:)649 ENDIF650 #endif651 652 611 !CALL oce_tam_deallocate( 2 ) ! deallocate adj variables 653 612 !CALL sbc_oce_tam_deallocate( 2 ) … … 669 628 zsn_tlout ( :,:,:) = tsn_tl (:,:,:,jp_sal) 670 629 zsshn_tlout( :,:) = sshn_tl ( :,:) 671 672 #if defined key_obc673 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 #endif679 630 680 631 !-------------------------------------------------------------------- … … 688 639 & * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) & 689 640 & * umask(ji,jj,jk) * wesp_u 690 #if defined key_obc691 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_u694 #endif695 641 END DO 696 642 END DO … … 703 649 & * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) & 704 650 & * vmask(ji,jj,jk) * wesp_u 705 #if defined key_obc706 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_u709 #endif710 651 END DO 711 652 END DO … … 718 659 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) & 719 660 & * tmask(ji,jj,jk) * wesp_t(jk) 720 #if defined key_obc721 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 #endif725 661 END DO 726 662 END DO … … 733 669 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) & 734 670 & * tmask(ji,jj,jk) * wesp_s(jk) 735 #if defined key_obc736 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 #endif740 671 END DO 741 672 END DO … … 747 678 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) & 748 679 & * tmask(ji,jj,1) * wesp_ssh 749 #if defined key_obc750 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_ssh753 #endif754 680 END DO 755 681 END DO … … 767 693 zsp1 = zsp1_U + zsp1_V + zsp1_T + zsp1_S + zsp1_SSH 768 694 769 #if defined key_obc770 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 #endif778 695 !-------------------------------------------------------------------- 779 696 ! Call the adjoint routine: dx^* = L^T dy^* … … 798 715 tsn_ad (:,:,:,jp_sal) = zsn_adin (:,:,:) 799 716 sshn_ad( :,:) = zsshn_adin ( :,:) 800 801 #if defined key_obc802 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 #endif808 717 809 718 !CALL oce_tam_deallocate( 1 ) !deallocate tl variables -
branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/tamtst.F90
r3611 r3658 129 129 130 130 ! Initialize energy weights 131 132 131 CALL par_esp 133 132
Note: See TracChangeset
for help on using the changeset viewer.
