- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/ASM/asminc.F90 (modified) (39 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/ASM/asminc.F90
r10425 r13463 94 94 95 95 !! * Substitutions 96 # include "vectopt_loop_substitute.h90" 96 # include "do_loop_substitute.h90" 97 # include "domzgr_substitute.h90" 97 98 !!---------------------------------------------------------------------- 98 99 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 102 103 CONTAINS 103 104 104 SUBROUTINE asm_inc_init 105 SUBROUTINE asm_inc_init( Kbb, Kmm, Krhs ) 105 106 !!---------------------------------------------------------------------- 106 107 !! *** ROUTINE asm_inc_init *** … … 112 113 !! ** Action : 113 114 !!---------------------------------------------------------------------- 115 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 116 ! 114 117 INTEGER :: ji, jj, jk, jt ! dummy loop indices 115 118 INTEGER :: imid, inum ! local integers … … 145 148 ln_temnofreeze = .FALSE. 146 149 147 REWIND( numnam_ref ) ! Namelist nam_asminc in reference namelist : Assimilation increment148 150 READ ( numnam_ref, nam_asminc, IOSTAT = ios, ERR = 901) 149 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_asminc in reference namelist', lwp ) 150 REWIND( numnam_cfg ) ! Namelist nam_asminc in configuration namelist : Assimilation increment 151 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_asminc in reference namelist' ) 151 152 READ ( numnam_cfg, nam_asminc, IOSTAT = ios, ERR = 902 ) 152 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nam_asminc in configuration namelist' , lwp)153 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nam_asminc in configuration namelist' ) 153 154 IF(lwm) WRITE ( numond, nam_asminc ) 154 155 … … 359 360 360 361 IF ( ln_trainc ) THEN 361 CALL iom_get( inum, jpdom_auto glo, 'bckint', t_bkginc, 1 )362 CALL iom_get( inum, jpdom_auto glo, 'bckins', s_bkginc, 1 )362 CALL iom_get( inum, jpdom_auto, 'bckint', t_bkginc, 1 ) 363 CALL iom_get( inum, jpdom_auto, 'bckins', s_bkginc, 1 ) 363 364 ! Apply the masks 364 365 t_bkginc(:,:,:) = t_bkginc(:,:,:) * tmask(:,:,:) … … 371 372 372 373 IF ( ln_dyninc ) THEN 373 CALL iom_get( inum, jpdom_auto glo, 'bckinu', u_bkginc, 1 )374 CALL iom_get( inum, jpdom_auto glo, 'bckinv', v_bkginc, 1 )374 CALL iom_get( inum, jpdom_auto, 'bckinu', u_bkginc, 1 ) 375 CALL iom_get( inum, jpdom_auto, 'bckinv', v_bkginc, 1 ) 375 376 ! Apply the masks 376 377 u_bkginc(:,:,:) = u_bkginc(:,:,:) * umask(:,:,:) … … 383 384 384 385 IF ( ln_sshinc ) THEN 385 CALL iom_get( inum, jpdom_auto glo, 'bckineta', ssh_bkginc, 1 )386 CALL iom_get( inum, jpdom_auto, 'bckineta', ssh_bkginc, 1 ) 386 387 ! Apply the masks 387 388 ssh_bkginc(:,:) = ssh_bkginc(:,:) * tmask(:,:,1) … … 392 393 393 394 IF ( ln_seaiceinc ) THEN 394 CALL iom_get( inum, jpdom_auto glo, 'bckinseaice', seaice_bkginc, 1 )395 CALL iom_get( inum, jpdom_auto, 'bckinseaice', seaice_bkginc, 1 ) 395 396 ! Apply the masks 396 397 seaice_bkginc(:,:) = seaice_bkginc(:,:) * tmask(:,:,1) … … 413 414 DO jk = 1, jpkm1 ! zhdiv = e1e1 * div 414 415 zhdiv(:,:) = 0._wp 415 DO jj = 2, jpjm1 416 DO ji = fs_2, fs_jpim1 ! vector opt. 417 zhdiv(ji,jj) = ( e2u(ji ,jj) * e3u_n(ji ,jj,jk) * u_bkginc(ji ,jj,jk) & 418 & - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * u_bkginc(ji-1,jj,jk) & 419 & + e1v(ji,jj ) * e3v_n(ji,jj ,jk) * v_bkginc(ji,jj ,jk) & 420 & - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * v_bkginc(ji,jj-1,jk) ) / e3t_n(ji,jj,jk) 421 END DO 422 END DO 423 CALL lbc_lnk( 'asminc', zhdiv, 'T', 1. ) ! lateral boundary cond. (no sign change) 416 DO_2D( 0, 0, 0, 0 ) 417 zhdiv(ji,jj) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * u_bkginc(ji ,jj,jk) & 418 & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * u_bkginc(ji-1,jj,jk) & 419 & + e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) * v_bkginc(ji,jj ,jk) & 420 & - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * v_bkginc(ji,jj-1,jk) ) & 421 & / e3t(ji,jj,jk,Kmm) 422 END_2D 423 CALL lbc_lnk( 'asminc', zhdiv, 'T', 1.0_wp ) ! lateral boundary cond. (no sign change) 424 424 ! 425 DO jj = 2, jpjm1 426 DO ji = fs_2, fs_jpim1 ! vector opt. 427 u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) & 428 & + 0.2_wp * ( zhdiv(ji+1,jj) - zhdiv(ji ,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 429 v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) & 430 & + 0.2_wp * ( zhdiv(ji,jj+1) - zhdiv(ji,jj ) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 431 END DO 432 END DO 425 DO_2D( 0, 0, 0, 0 ) 426 u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) & 427 & + 0.2_wp * ( zhdiv(ji+1,jj) - zhdiv(ji ,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 428 v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) & 429 & + 0.2_wp * ( zhdiv(ji,jj+1) - zhdiv(ji,jj ) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 430 END_2D 433 431 END DO 434 432 ! … … 469 467 ! 470 468 IF ( ln_trainc ) THEN 471 CALL iom_get( inum, jpdom_auto glo, 'tn', t_bkg )472 CALL iom_get( inum, jpdom_auto glo, 'sn', s_bkg )469 CALL iom_get( inum, jpdom_auto, 'tn', t_bkg ) 470 CALL iom_get( inum, jpdom_auto, 'sn', s_bkg ) 473 471 t_bkg(:,:,:) = t_bkg(:,:,:) * tmask(:,:,:) 474 472 s_bkg(:,:,:) = s_bkg(:,:,:) * tmask(:,:,:) … … 476 474 ! 477 475 IF ( ln_dyninc ) THEN 478 CALL iom_get( inum, jpdom_auto glo, 'un', u_bkg)479 CALL iom_get( inum, jpdom_auto glo, 'vn', v_bkg)476 CALL iom_get( inum, jpdom_auto, 'un', u_bkg, cd_type = 'U', psgn = 1._wp ) 477 CALL iom_get( inum, jpdom_auto, 'vn', v_bkg, cd_type = 'V', psgn = 1._wp ) 480 478 u_bkg(:,:,:) = u_bkg(:,:,:) * umask(:,:,:) 481 479 v_bkg(:,:,:) = v_bkg(:,:,:) * vmask(:,:,:) … … 483 481 ! 484 482 IF ( ln_sshinc ) THEN 485 CALL iom_get( inum, jpdom_auto glo, 'sshn', ssh_bkg )483 CALL iom_get( inum, jpdom_auto, 'sshn', ssh_bkg ) 486 484 ssh_bkg(:,:) = ssh_bkg(:,:) * tmask(:,:,1) 487 485 ENDIF … … 491 489 ENDIF 492 490 ! 493 IF(lwp) WRITE(numout,*) ' ==>>> Euler time step switch is ', neuler491 IF(lwp) WRITE(numout,*) ' ==>>> Euler time step switch is ', l_1st_euler 494 492 ! 495 493 IF( lk_asminc ) THEN !== data assimilation ==! 496 IF( ln_bkgwri ) CALL asm_bkg_wri( nit000 - 1 ) ! Output background fields494 IF( ln_bkgwri ) CALL asm_bkg_wri( nit000 - 1, Kmm ) ! Output background fields 497 495 IF( ln_asmdin ) THEN ! Direct initialization 498 IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1 ) ! Tracers499 IF( ln_dyninc ) CALL dyn_asm_inc( nit000 - 1 ) ! Dynamics500 IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 )! SSH496 IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1, Kbb, Kmm, ts , Krhs ) ! Tracers 497 IF( ln_dyninc ) CALL dyn_asm_inc( nit000 - 1, Kbb, Kmm, uu, vv, Krhs ) ! Dynamics 498 IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1, Kbb, Kmm ) ! SSH 501 499 ENDIF 502 500 ENDIF … … 505 503 506 504 507 SUBROUTINE tra_asm_inc( kt )505 SUBROUTINE tra_asm_inc( kt, Kbb, Kmm, pts, Krhs ) 508 506 !!---------------------------------------------------------------------- 509 507 !! *** ROUTINE tra_asm_inc *** … … 515 513 !! ** Action : 516 514 !!---------------------------------------------------------------------- 517 INTEGER, INTENT(IN) :: kt ! Current time step 515 INTEGER , INTENT(in ) :: kt ! Current time step 516 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! Time level indices 517 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 518 518 ! 519 519 INTEGER :: ji, jj, jk … … 526 526 ! used to prevent the applied increments taking the temperature below the local freezing point 527 527 DO jk = 1, jpkm1 528 CALL eos_fzp( tsn(:,:,jk,jp_sal), fzptnz(:,:,jk), gdept_n(:,:,jk) )528 CALL eos_fzp( pts(:,:,jk,jp_sal,Kmm), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) ) 529 529 END DO 530 530 ! … … 536 536 ! 537 537 it = kt - nit000 + 1 538 zincwgt = wgtiau(it) / r dt ! IAU weight for the current time step538 zincwgt = wgtiau(it) / rn_Dt ! IAU weight for the current time step 539 539 ! 540 540 IF(lwp) THEN … … 549 549 ! Do not apply negative increments if the temperature will fall below freezing 550 550 WHERE(t_bkginc(:,:,jk) > 0.0_wp .OR. & 551 & tsn(:,:,jk,jp_tem) + tsa(:,:,jk,jp_tem) + t_bkginc(:,:,jk) * wgtiau(it) > fzptnz(:,:,jk) )552 tsa(:,:,jk,jp_tem) = tsa(:,:,jk,jp_tem) + t_bkginc(:,:,jk) * zincwgt551 & pts(:,:,jk,jp_tem,Kmm) + pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * wgtiau(it) > fzptnz(:,:,jk) ) 552 pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt 553 553 END WHERE 554 554 ELSE 555 tsa(:,:,jk,jp_tem) = tsa(:,:,jk,jp_tem) + t_bkginc(:,:,jk) * zincwgt555 pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt 556 556 ENDIF 557 557 IF (ln_salfix) THEN … … 559 559 ! minimum value salfixmin 560 560 WHERE(s_bkginc(:,:,jk) > 0.0_wp .OR. & 561 & tsn(:,:,jk,jp_sal) + tsa(:,:,jk,jp_sal) + s_bkginc(:,:,jk) * wgtiau(it) > salfixmin )562 tsa(:,:,jk,jp_sal) = tsa(:,:,jk,jp_sal) + s_bkginc(:,:,jk) * zincwgt561 & pts(:,:,jk,jp_sal,Kmm) + pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * wgtiau(it) > salfixmin ) 562 pts(:,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt 563 563 END WHERE 564 564 ELSE 565 tsa(:,:,jk,jp_sal) = tsa(:,:,jk,jp_sal) + s_bkginc(:,:,jk) * zincwgt565 pts(:,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt 566 566 ENDIF 567 567 END DO … … 579 579 IF ( kt == nitdin_r ) THEN 580 580 ! 581 neuler = 0! Force Euler forward step581 l_1st_euler = .TRUE. ! Force Euler forward step 582 582 ! 583 583 ! Initialize the now fields with the background + increment 584 584 IF (ln_temnofreeze) THEN 585 585 ! Do not apply negative increments if the temperature will fall below freezing 586 WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. tsn(:,:,:,jp_tem) + t_bkginc(:,:,:) > fzptnz(:,:,:) )587 tsn(:,:,:,jp_tem) = t_bkg(:,:,:) + t_bkginc(:,:,:)586 WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_tem,Kmm) + t_bkginc(:,:,:) > fzptnz(:,:,:) ) 587 pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 588 588 END WHERE 589 589 ELSE 590 tsn(:,:,:,jp_tem) = t_bkg(:,:,:) + t_bkginc(:,:,:)590 pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 591 591 ENDIF 592 592 IF (ln_salfix) THEN 593 593 ! Do not apply negative increments if the salinity will fall below a specified 594 594 ! minimum value salfixmin 595 WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. tsn(:,:,:,jp_sal) + s_bkginc(:,:,:) > salfixmin )596 tsn(:,:,:,jp_sal) = s_bkg(:,:,:) + s_bkginc(:,:,:)595 WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_sal,Kmm) + s_bkginc(:,:,:) > salfixmin ) 596 pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 597 597 END WHERE 598 598 ELSE 599 tsn(:,:,:,jp_sal) = s_bkg(:,:,:) + s_bkginc(:,:,:)599 pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 600 600 ENDIF 601 601 602 tsb(:,:,:,:) = tsn(:,:,:,:) ! Update before fields603 604 CALL eos( tsb, rhd, rhop, gdept_0(:,:,:) ) ! Before potential and in situ densities602 pts(:,:,:,:,Kbb) = pts(:,:,:,:,Kmm) ! Update before fields 603 604 CALL eos( pts(:,:,:,:,Kbb), rhd, rhop, gdept_0(:,:,:) ) ! Before potential and in situ densities 605 605 !!gm fabien 606 ! CALL eos( tsb, rhd, rhop ) ! Before potential and in situ densities606 ! CALL eos( pts(:,:,:,:,Kbb), rhd, rhop ) ! Before potential and in situ densities 607 607 !!gm 608 608 609 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav) &610 & CALL zps_hde ( kt, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient611 & rhd, gru , grv ) ! of t, s, rd at the last ocean level612 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav) &613 & CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv, gtui, gtvi, &! Partial steps for top cell (ISF)614 & rhd, gru , grv , grui, grvi )! of t, s, rd at the last ocean level609 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav) & 610 & CALL zps_hde ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, & ! Partial steps: before horizontal gradient 611 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 612 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav) & 613 & CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 614 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the last ocean level 615 615 616 616 DEALLOCATE( t_bkginc ) … … 627 627 628 628 629 SUBROUTINE dyn_asm_inc( kt )629 SUBROUTINE dyn_asm_inc( kt, Kbb, Kmm, puu, pvv, Krhs ) 630 630 !!---------------------------------------------------------------------- 631 631 !! *** ROUTINE dyn_asm_inc *** … … 637 637 !! ** Action : 638 638 !!---------------------------------------------------------------------- 639 INTEGER, INTENT(IN) :: kt ! Current time step 639 INTEGER , INTENT( in ) :: kt ! ocean time-step index 640 INTEGER , INTENT( in ) :: Kbb, Kmm, Krhs ! ocean time level indices 641 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation 640 642 ! 641 643 INTEGER :: jk … … 651 653 ! 652 654 it = kt - nit000 + 1 653 zincwgt = wgtiau(it) / r dt ! IAU weight for the current time step655 zincwgt = wgtiau(it) / rn_Dt ! IAU weight for the current time step 654 656 ! 655 657 IF(lwp) THEN … … 661 663 ! Update the dynamic tendencies 662 664 DO jk = 1, jpkm1 663 ua(:,:,jk) = ua(:,:,jk) + u_bkginc(:,:,jk) * zincwgt664 va(:,:,jk) = va(:,:,jk) + v_bkginc(:,:,jk) * zincwgt665 puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + u_bkginc(:,:,jk) * zincwgt 666 pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + v_bkginc(:,:,jk) * zincwgt 665 667 END DO 666 668 ! … … 677 679 IF ( kt == nitdin_r ) THEN 678 680 ! 679 neuler = 0! Force Euler forward step681 l_1st_euler = .TRUE. ! Force Euler forward step 680 682 ! 681 683 ! Initialize the now fields with the background + increment 682 un(:,:,:) = u_bkg(:,:,:) + u_bkginc(:,:,:)683 vn(:,:,:) = v_bkg(:,:,:) + v_bkginc(:,:,:)684 ! 685 ub(:,:,:) = un(:,:,:) ! Update before fields686 vb(:,:,:) = vn(:,:,:)684 puu(:,:,:,Kmm) = u_bkg(:,:,:) + u_bkginc(:,:,:) 685 pvv(:,:,:,Kmm) = v_bkg(:,:,:) + v_bkginc(:,:,:) 686 ! 687 puu(:,:,:,Kbb) = puu(:,:,:,Kmm) ! Update before fields 688 pvv(:,:,:,Kbb) = pvv(:,:,:,Kmm) 687 689 ! 688 690 DEALLOCATE( u_bkg ) … … 697 699 698 700 699 SUBROUTINE ssh_asm_inc( kt )701 SUBROUTINE ssh_asm_inc( kt, Kbb, Kmm ) 700 702 !!---------------------------------------------------------------------- 701 703 !! *** ROUTINE ssh_asm_inc *** … … 707 709 !! ** Action : 708 710 !!---------------------------------------------------------------------- 709 INTEGER, INTENT(IN) :: kt ! Current time step 711 INTEGER, INTENT(IN) :: kt ! Current time step 712 INTEGER, INTENT(IN) :: Kbb, Kmm ! Current time step 710 713 ! 711 714 INTEGER :: it … … 721 724 ! 722 725 it = kt - nit000 + 1 723 zincwgt = wgtiau(it) / r dt ! IAU weight for the current time step726 zincwgt = wgtiau(it) / rn_Dt ! IAU weight for the current time step 724 727 ! 725 728 IF(lwp) THEN … … 752 755 IF ( kt == nitdin_r ) THEN 753 756 ! 754 neuler = 0 ! Force Euler forward step 755 ! 756 sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:) ! Initialize the now fields the background + increment 757 ! 758 sshb(:,:) = sshn(:,:) ! Update before fields 759 e3t_b(:,:,:) = e3t_n(:,:,:) 760 !!gm why not e3u_b, e3v_b, gdept_b ???? 757 l_1st_euler = .TRUE. ! Force Euler forward step 758 ! 759 ssh(:,:,Kmm) = ssh_bkg(:,:) + ssh_bkginc(:,:) ! Initialize the now fields the background + increment 760 ! 761 ssh(:,:,Kbb) = ssh(:,:,Kmm) ! Update before fields 762 #if ! defined key_qco 763 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 764 #endif 765 !!gm why not e3u(:,:,:,Kbb), e3v(:,:,:,Kbb), gdept(:,:,:,Kbb) ???? 761 766 ! 762 767 DEALLOCATE( ssh_bkg ) … … 770 775 771 776 772 SUBROUTINE ssh_asm_div( kt, phdivn )777 SUBROUTINE ssh_asm_div( kt, Kbb, Kmm, phdivn ) 773 778 !!---------------------------------------------------------------------- 774 779 !! *** ROUTINE ssh_asm_div *** … … 784 789 !!---------------------------------------------------------------------- 785 790 INTEGER, INTENT(IN) :: kt ! ocean time-step index 791 INTEGER, INTENT(IN) :: Kbb, Kmm ! time level indices 786 792 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phdivn ! horizontal divergence 787 793 !! … … 791 797 ! 792 798 #if defined key_asminc 793 CALL ssh_asm_inc( kt ) !== (calculate increments)799 CALL ssh_asm_inc( kt, Kbb, Kmm ) !== (calculate increments) 794 800 ! 795 801 IF( ln_linssh ) THEN 796 phdivn(:,:,1) = phdivn(:,:,1) - ssh_iau(:,:) / e3t _n(:,:,1) * tmask(:,:,1)802 phdivn(:,:,1) = phdivn(:,:,1) - ssh_iau(:,:) / e3t(:,:,1,Kmm) * tmask(:,:,1) 797 803 ELSE 798 804 ALLOCATE( ztim(jpi,jpj) ) 799 ztim(:,:) = ssh_iau(:,:) / ( ht _n(:,:) + 1.0 - ssmask(:,:) )805 ztim(:,:) = ssh_iau(:,:) / ( ht(:,:) + 1.0 - ssmask(:,:) ) 800 806 DO jk = 1, jpkm1 801 807 phdivn(:,:,jk) = phdivn(:,:,jk) - ztim(:,:) * tmask(:,:,jk) … … 839 845 it = kt - nit000 + 1 840 846 zincwgt = wgtiau(it) ! IAU weight for the current time step 841 ! note this is not a tendency so should not be divided by r dt (as with the tracer and other increments)847 ! note this is not a tendency so should not be divided by rn_Dt (as with the tracer and other increments) 842 848 ! 843 849 IF(lwp) THEN … … 874 880 #if defined key_cice && defined key_asminc 875 881 ! Sea-ice : CICE case. Pass ice increment tendency into CICE 876 ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / r dt882 ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rn_Dt 877 883 #endif 878 884 ! … … 894 900 IF ( kt == nitdin_r ) THEN 895 901 ! 896 neuler = 0! Force Euler forward step902 l_1st_euler = .TRUE. ! Force Euler forward step 897 903 ! 898 904 ! Sea-ice : SI3 case … … 924 930 #if defined key_cice && defined key_asminc 925 931 ! Sea-ice : CICE case. Pass ice increment tendency into CICE 926 ndaice_da(:,:) = seaice_bkginc(:,:) / r dt932 ndaice_da(:,:) = seaice_bkginc(:,:) / rn_Dt 927 933 #endif 928 934 IF ( .NOT. PRESENT(kindic) ) THEN … … 957 963 ! ! fwf : ice formation and melting 958 964 ! 959 ! zfons = ( -nfresh_da(ji,jj)*soce + nfsalt_da(ji,jj) )*r dt965 ! zfons = ( -nfresh_da(ji,jj)*soce + nfsalt_da(ji,jj) )*rn_Dt 960 966 ! 961 967 ! ! change salinity down to mixed layer depth … … 968 974 ! ! set to bottom of a level 969 975 ! DO jk = jpk-1, 2, -1 970 ! IF ((mld > gdepw(ji,jj,jk )) .and. (mld < gdepw(ji,jj,jk+1))) THEN971 ! mld=gdepw(ji,jj,jk+1 )976 ! IF ((mld > gdepw(ji,jj,jk,Kmm)) .and. (mld < gdepw(ji,jj,jk+1,Kmm))) THEN 977 ! mld=gdepw(ji,jj,jk+1,Kmm) 972 978 ! jkmax=jk 973 979 ! ENDIF … … 998 1004 ! 999 1005 ! ! ! salt exchanges at the ice/ocean interface 1000 ! ! zpmess = zfons / r dt_ice ! rdt_ice is ice timestep1006 ! ! zpmess = zfons / rDt_ice ! rDt_ice is ice timestep 1001 1007 ! ! 1002 1008 ! !! Adjust fsalt. A +ve fsalt means adding salt to ocean
Note: See TracChangeset
for help on using the changeset viewer.
