Changeset 5777
- Timestamp:
- 2015-10-06T13:40:42+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO
- Files:
-
- 8 deleted
- 93 edited
- 2 moved
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90
r4624 r5777 71 71 CALL fld_read( kt, nn_fsbc, sf_icedmp ) 72 72 ! 73 !CDIR COLLAPSE74 73 hicif(:,:) = MAX( 0._wp, & ! h >= 0 avoid spurious out of physical range 75 74 & hicif(:,:) - rdt_ice * resto_ice(:,:,1) * ( hicif(:,:) - sf_icedmp(jp_hicif)%fnow(:,:,1) ) ) 76 !CDIR COLLAPSE77 75 frld (:,:) = MAX( 0._wp, MIN( 1._wp, & ! 0<= frld<=1 values which blow the run up 78 76 & frld (:,:) - rdt_ice * resto_ice(:,:,1) * ( frld (:,:) - sf_icedmp(jp_frld )%fnow(:,:,1) ) ) ) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90
r5123 r5777 160 160 !------------------------------------------------------------------- 161 161 162 !CDIR NOVERRCHK163 162 DO jj = k_j1 , k_jpj-1 164 !CDIR NOVERRCHK165 163 DO ji = 1 , jpi 166 164 ! only the sinus changes its sign with the hemisphere … … 245 243 ! Computation of free drift field for free slip boundary conditions. 246 244 247 !CDIR NOVERRCHK248 245 DO jj = k_j1, k_jpj-1 249 !CDIR NOVERRCHK250 246 DO ji = 1, fs_jpim1 251 247 !- Rate of strain tensor. … … 401 397 iflag: DO jter = 1 , nbitdr ! Relaxation ! 402 398 ! ! ================ ! 403 !CDIR NOVERRCHK404 399 DO jj = k_j1+1, k_jpj-1 405 !CDIR NOVERRCHK406 400 DO ji = 2, fs_jpim1 ! NO vector opt. 407 401 ! -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r5407 r5777 319 319 ! 320 320 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) 321 !CDIR NOVERRCHK 321 ! 322 322 DO jj = 1, jpj !* modulus of ice-ocean relative velocity at I-point 323 !CDIR NOVERRCHK324 323 DO ji = 1, jpi 325 324 zu_i = u_ice(ji,jj) - u_oce(ji,jj) ! ice-ocean relative velocity at I-point … … 328 327 END DO 329 328 END DO 330 !CDIR NOVERRCHK331 329 DO jj = 1, jpjm1 !* update the modulus of stress at ocean surface (T-point) 332 !CDIR NOVERRCHK333 330 DO ji = 1, jpim1 ! NO vector opt. 334 331 ! ! modulus of U_ice-U_oce at T-point … … 383 380 ! 384 381 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) 385 !CDIR NOVERRCHK 382 ! 386 383 DO jj = 2, jpjm1 !* modulus of the ice-ocean velocity at T-point 387 !CDIR NOVERRCHK388 384 DO ji = fs_2, fs_jpim1 389 385 zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) ! 2*(U_ice-U_oce) at T-point -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r5407 r5777 196 196 !-------------------------------------------------------------------------- 197 197 198 !CDIR NOVERRCHK199 198 DO jj = 1, jpj 200 !CDIR NOVERRCHK201 199 DO ji = 1, jpi 202 200 zthsnice = hsnif(ji,jj) + hicif(ji,jj) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90
r3625 r5777 134 134 !--------------------------------------------------------------------- 135 135 136 !CDIR NOVERRCHK137 136 DO ji = kideb , kiut 138 137 iicefr = 1 - MAX( 0, INT( SIGN( 1.5 * zone , zfrl_old(ji) - 1.0 + epsi13 ) ) ) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r5737 r5777 14 14 15 15 !!---------------------------------------------------------------------- 16 !! 'key_asminc' : Switch on the assimilation increment interface17 !!----------------------------------------------------------------------18 16 !! asm_inc_init : Initialize the increment arrays and IAU weights 19 17 !! calc_date : Compute the calendar date YYYYMMDD on a given step … … 28 26 USE domvvl ! domain: variable volume level 29 27 USE oce ! Dynamics and active tracers defined in memory 30 USE ldfdyn _oce ! ocean dynamics: lateral physics28 USE ldfdyn ! lateral diffusion: eddy viscosity coefficients 31 29 USE eosbn2 ! Equation of state - in situ and potential density 32 30 USE zpshde ! Partial step : Horizontal Derivative … … 56 54 LOGICAL, PUBLIC, PARAMETER :: lk_asminc = .FALSE. !: No assimilation increments 57 55 #endif 58 LOGICAL, PUBLIC :: ln_bkgwri = .FALSE.!: No output of the background state fields59 LOGICAL, PUBLIC :: ln_asmiau = .FALSE.!: No applying forcing with an assimilation increment60 LOGICAL, PUBLIC :: ln_asmdin = .FALSE.!: No direct initialization61 LOGICAL, PUBLIC :: ln_trainc = .FALSE.!: No tracer (T and S) assimilation increments62 LOGICAL, PUBLIC :: ln_dyninc = .FALSE.!: No dynamics (u and v) assimilation increments63 LOGICAL, PUBLIC :: ln_sshinc = .FALSE.!: No sea surface height assimilation increment64 LOGICAL, PUBLIC :: ln_seaiceinc 65 LOGICAL, PUBLIC :: ln_salfix = .FALSE.!: Apply minimum salinity check56 LOGICAL, PUBLIC :: ln_bkgwri !: No output of the background state fields 57 LOGICAL, PUBLIC :: ln_asmiau !: No applying forcing with an assimilation increment 58 LOGICAL, PUBLIC :: ln_asmdin !: No direct initialization 59 LOGICAL, PUBLIC :: ln_trainc !: No tracer (T and S) assimilation increments 60 LOGICAL, PUBLIC :: ln_dyninc !: No dynamics (u and v) assimilation increments 61 LOGICAL, PUBLIC :: ln_sshinc !: No sea surface height assimilation increment 62 LOGICAL, PUBLIC :: ln_seaiceinc !: No sea ice concentration increment 63 LOGICAL, PUBLIC :: ln_salfix !: Apply minimum salinity check 66 64 LOGICAL, PUBLIC :: ln_temnofreeze = .FALSE. !: Don't allow the temperature to drop below freezing 67 INTEGER, PUBLIC :: nn_divdmp 65 INTEGER, PUBLIC :: nn_divdmp !: Apply divergence damping filter nn_divdmp times 68 66 69 67 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: t_bkg , s_bkg !: Background temperature and salinity … … 90 88 !! * Substitutions 91 89 # include "domzgr_substitute.h90" 92 # include "ldfdyn_substitute.h90"93 90 # include "vectopt_loop_substitute.h90" 94 91 !!---------------------------------------------------------------------- … … 139 136 ! Read Namelist nam_asminc : assimilation increment interface 140 137 !----------------------------------------------------------------------- 141 ln_seaiceinc = .FALSE.138 ln_seaiceinc = .FALSE. 142 139 ln_temnofreeze = .FALSE. 143 140 … … 428 425 429 426 IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN 430 431 CALL wrk_alloc( jpi,jpj,hdiv)432 433 DO 434 427 ! 428 CALL wrk_alloc( jpi,jpj, hdiv ) 429 ! 430 DO jt = 1, nn_divdmp 431 ! 435 432 DO jk = 1, jpkm1 436 437 433 hdiv(:,:) = 0._wp 438 439 434 DO jj = 2, jpjm1 440 435 DO ji = fs_2, fs_jpim1 ! vector opt. … … 447 442 END DO 448 443 END DO 449 450 444 CALL lbc_lnk( hdiv, 'T', 1. ) ! lateral boundary cond. (no sign change) 451 445 ! 452 446 DO jj = 2, jpjm1 453 447 DO ji = fs_2, fs_jpim1 ! vector opt. 454 448 u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji+1,jj) * hdiv(ji+1,jj) & 455 456 449 & - e1e2t(ji ,jj) * hdiv(ji ,jj) ) & 450 & * r1_e1u(ji,jj) * umask(ji,jj,jk) 457 451 v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji,jj+1) * hdiv(ji,jj+1) & 458 459 452 & - e1e2t(ji,jj ) * hdiv(ji,jj ) ) & 453 & * r1_e2v(ji,jj) * vmask(ji,jj,jk) 460 454 END DO 461 455 END DO 462 463 456 END DO 464 457 ! 465 458 END DO 466 467 CALL wrk_dealloc( jpi,jpj,hdiv)468 459 ! 460 CALL wrk_dealloc( jpi,jpj, hdiv ) 461 ! 469 462 ENDIF 470 471 472 463 473 464 !----------------------------------------------------------------------- … … 476 467 477 468 IF ( ln_asmdin ) THEN 478 469 ! 479 470 ALLOCATE( t_bkg(jpi,jpj,jpk) ) 480 471 ALLOCATE( s_bkg(jpi,jpj,jpk) ) … … 482 473 ALLOCATE( v_bkg(jpi,jpj,jpk) ) 483 474 ALLOCATE( ssh_bkg(jpi,jpj) ) 484 485 t_bkg(:,:,:) = 0. 0486 s_bkg(:,:,:) = 0. 0487 u_bkg(:,:,:) = 0. 0488 v_bkg(:,:,:) = 0. 0489 ssh_bkg(:,:) = 0. 0490 475 ! 476 t_bkg(:,:,:) = 0._wp 477 s_bkg(:,:,:) = 0._wp 478 u_bkg(:,:,:) = 0._wp 479 v_bkg(:,:,:) = 0._wp 480 ssh_bkg(:,:) = 0._wp 481 ! 491 482 !-------------------------------------------------------------------- 492 483 ! Read from file the background state at analysis time 493 484 !-------------------------------------------------------------------- 494 485 ! 495 486 CALL iom_open( c_asmdin, inum ) 496 487 ! 497 488 CALL iom_get( inum, 'rdastp', zdate_bkg ) 498 489 ! 499 490 IF(lwp) THEN 500 491 WRITE(numout,*) 501 WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', & 502 & NINT( zdate_bkg ) 492 WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', NINT( zdate_bkg ) 503 493 WRITE(numout,*) '~~~~~~~~~~~~' 504 494 ENDIF 505 495 ! 506 496 IF ( NINT( zdate_bkg ) /= iitdin_date ) & 507 497 & CALL ctl_warn( ' Validity time of assimilation background state does', & 508 498 & ' not agree with Direct Initialization time' ) 509 499 ! 510 500 IF ( ln_trainc ) THEN 511 501 CALL iom_get( inum, jpdom_autoglo, 'tn', t_bkg ) … … 514 504 s_bkg(:,:,:) = s_bkg(:,:,:) * tmask(:,:,:) 515 505 ENDIF 516 506 ! 517 507 IF ( ln_dyninc ) THEN 518 508 CALL iom_get( inum, jpdom_autoglo, 'un', u_bkg ) … … 521 511 v_bkg(:,:,:) = v_bkg(:,:,:) * vmask(:,:,:) 522 512 ENDIF 523 513 ! 524 514 IF ( ln_sshinc ) THEN 525 515 CALL iom_get( inum, jpdom_autoglo, 'sshn', ssh_bkg ) 526 516 ssh_bkg(:,:) = ssh_bkg(:,:) * tmask(:,:,1) 527 517 ENDIF 528 518 ! 529 519 CALL iom_close( inum ) 530 520 ! 531 521 ENDIF 532 522 ! … … 574 564 ! If kt = kit000 - 1 then set the date to the restart date 575 565 IF ( kt == kit000 - 1 ) THEN 576 577 566 kdate = ndastp 578 567 RETURN 579 580 568 ENDIF 581 569 … … 646 634 !! ** Action : 647 635 !!---------------------------------------------------------------------- 648 INTEGER, INTENT(IN) :: kt! Current time step649 ! 650 INTEGER :: ji,jj,jk651 INTEGER :: it636 INTEGER, INTENT(IN) :: kt ! Current time step 637 ! 638 INTEGER :: ji, jj, jk 639 INTEGER :: it 652 640 REAL(wp) :: zincwgt ! IAU weight for current time step 653 641 REAL (wp), DIMENSION(jpi,jpj,jpk) :: fzptnz ! 3d freezing point values 654 642 !!---------------------------------------------------------------------- 655 643 ! 656 644 ! freezing point calculation taken from oc_fz_pt (but calculated for all depths) 657 645 ! used to prevent the applied increments taking the temperature below the local freezing point 658 659 646 DO jk = 1, jpkm1 660 647 CALL eos_fzp( tsn(:,:,jk,jp_sal), fzptnz(:,:,jk), fsdept(:,:,jk) ) 661 648 END DO 662 663 IF ( ln_asmiau ) THEN 664 665 !-------------------------------------------------------------------- 666 ! Incremental Analysis Updating 667 !-------------------------------------------------------------------- 668 649 ! 650 ! !-------------------------------------- 651 IF ( ln_asmiau ) THEN ! Incremental Analysis Updating 652 ! !-------------------------------------- 653 ! 669 654 IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN 670 655 ! 671 656 it = kt - nit000 + 1 672 657 zincwgt = wgtiau(it) / rdt ! IAU weight for the current time step 673 658 ! 674 659 IF(lwp) THEN 675 660 WRITE(numout,*) … … 677 662 WRITE(numout,*) '~~~~~~~~~~~~' 678 663 ENDIF 679 664 ! 680 665 ! Update the tracer tendencies 681 666 DO jk = 1, jpkm1 … … 700 685 ENDIF 701 686 END DO 702 703 ENDIF 704 687 ! 688 ENDIF 689 ! 705 690 IF ( kt == nitiaufin_r + 1 ) THEN ! For bias crcn to work 706 691 DEALLOCATE( t_bkginc ) 707 692 DEALLOCATE( s_bkginc ) 708 693 ENDIF 709 710 711 ELSEIF ( ln_asmdin ) THEN 712 713 !-------------------------------------------------------------------- 714 ! Direct Initialization 715 !-------------------------------------------------------------------- 716 694 ! !-------------------------------------- 695 ELSEIF ( ln_asmdin ) THEN ! Direct Initialization 696 ! !-------------------------------------- 697 ! 717 698 IF ( kt == nitdin_r ) THEN 718 699 ! 719 700 neuler = 0 ! Force Euler forward step 720 701 ! 721 702 ! Initialize the now fields with the background + increment 722 703 IF (ln_temnofreeze) THEN … … 745 726 !!gm 746 727 747 748 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav) & 749 & CALL zps_hde ( kt, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient 750 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 751 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav) & 752 & CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv, & ! Partial steps for top cell (ISF) 753 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 754 & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level 728 IF( ln_zps .AND. .NOT. lk_c1d ) THEN ! Partial steps: before horizontal gradient 729 IF(ln_isfcav) THEN ! ocean cavities: top and bottom cells (ISF) 730 CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv, gtui, gtvi, & 731 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 732 & grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) 733 ELSE ! no ocean cavities: bottom cells 734 CALL zps_hde ( kt, jpts, tsb, gtsu, gtsv, & ! 735 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 736 ENDIF 737 ENDIF 755 738 756 739 #if defined key_zdfkpp … … 758 741 !!gm fabien CALL eos( tsn, rhd ) ! Compute rhd 759 742 #endif 760 743 ! 761 744 DEALLOCATE( t_bkginc ) 762 745 DEALLOCATE( s_bkginc ) … … 767 750 ENDIF 768 751 ! Perhaps the following call should be in step 769 IF 752 IF ( ln_seaiceinc ) CALL seaice_asm_inc ( kt ) ! apply sea ice concentration increment 770 753 ! 771 754 END SUBROUTINE tra_asm_inc … … 788 771 REAL(wp) :: zincwgt ! IAU weight for current time step 789 772 !!---------------------------------------------------------------------- 790 791 IF ( ln_asmiau ) THEN 792 793 !-------------------------------------------------------------------- 794 ! Incremental Analysis Updating 795 !-------------------------------------------------------------------- 796 773 ! 774 ! !-------------------------------------------- 775 IF ( ln_asmiau ) THEN ! Incremental Analysis Updating 776 ! !-------------------------------------------- 777 ! 797 778 IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN 798 779 ! 799 780 it = kt - nit000 + 1 800 781 zincwgt = wgtiau(it) / rdt ! IAU weight for the current time step 801 782 ! 802 783 IF(lwp) THEN 803 784 WRITE(numout,*) 804 WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', & 805 & kt,' with IAU weight = ', wgtiau(it) 785 WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 806 786 WRITE(numout,*) '~~~~~~~~~~~~' 807 787 ENDIF 808 788 ! 809 789 ! Update the dynamic tendencies 810 790 DO jk = 1, jpkm1 … … 812 792 va(:,:,jk) = va(:,:,jk) + v_bkginc(:,:,jk) * zincwgt 813 793 END DO 814 794 ! 815 795 IF ( kt == nitiaufin_r ) THEN 816 796 DEALLOCATE( u_bkginc ) 817 797 DEALLOCATE( v_bkginc ) 818 798 ENDIF 819 820 ENDIF 821 822 ELSEIF ( ln_asmdin ) THEN 823 824 !-------------------------------------------------------------------- 825 ! Direct Initialization 826 !-------------------------------------------------------------------- 827 799 ! 800 ENDIF 801 ! !----------------------------------------- 802 ELSEIF ( ln_asmdin ) THEN ! Direct Initialization 803 ! !----------------------------------------- 804 ! 828 805 IF ( kt == nitdin_r ) THEN 829 806 ! 830 807 neuler = 0 ! Force Euler forward step 831 808 ! 832 809 ! Initialize the now fields with the background + increment 833 810 un(:,:,:) = u_bkg(:,:,:) + u_bkginc(:,:,:) 834 811 vn(:,:,:) = v_bkg(:,:,:) + v_bkginc(:,:,:) 835 812 ! 836 813 ub(:,:,:) = un(:,:,:) ! Update before fields 837 814 vb(:,:,:) = vn(:,:,:) 838 815 ! 839 816 DEALLOCATE( u_bkg ) 840 817 DEALLOCATE( v_bkg ) … … 864 841 REAL(wp) :: zincwgt ! IAU weight for current time step 865 842 !!---------------------------------------------------------------------- 866 867 IF ( ln_asmiau ) THEN 868 869 !-------------------------------------------------------------------- 870 ! Incremental Analysis Updating 871 !-------------------------------------------------------------------- 872 843 ! 844 ! !----------------------------------------- 845 IF ( ln_asmiau ) THEN ! Incremental Analysis Updating 846 ! !----------------------------------------- 847 ! 873 848 IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN 874 849 ! 875 850 it = kt - nit000 + 1 876 851 zincwgt = wgtiau(it) / rdt ! IAU weight for the current time step 877 852 ! 878 853 IF(lwp) THEN 879 854 WRITE(numout,*) … … 882 857 WRITE(numout,*) '~~~~~~~~~~~~' 883 858 ENDIF 884 859 ! 885 860 ! Save the tendency associated with the IAU weighted SSH increment 886 861 ! (applied in dynspg.*) … … 891 866 DEALLOCATE( ssh_bkginc ) 892 867 ENDIF 893 894 ENDIF 895 896 ELSEIF ( ln_asmdin ) THEN 897 898 !-------------------------------------------------------------------- 899 ! Direct Initialization 900 !-------------------------------------------------------------------- 901 868 ! 869 ENDIF 870 ! !----------------------------------------- 871 ELSEIF ( ln_asmdin ) THEN ! Direct Initialization 872 ! !----------------------------------------- 873 ! 902 874 IF ( kt == nitdin_r ) THEN 903 904 neuler = 0 ! Force Euler forward step 905 906 ! Initialize the now fields the background + increment 907 sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:) 908 909 ! Update before fields 910 sshb(:,:) = sshn(:,:) 911 875 ! 876 neuler = 0 ! Force Euler forward step 877 ! 878 sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:) ! Initialize the now fields the background + increment 879 ! 880 sshb(:,:) = sshn(:,:) ! Update before fields 881 ! 912 882 IF( lk_vvl ) THEN 913 883 DO jk = 1, jpk … … 915 885 END DO 916 886 ENDIF 917 887 ! 918 888 DEALLOCATE( ssh_bkg ) 919 889 DEALLOCATE( ssh_bkginc ) 920 890 ! 921 891 ENDIF 922 892 ! … … 937 907 !! 938 908 !!---------------------------------------------------------------------- 939 IMPLICIT NONE 940 ! 941 INTEGER, INTENT(in) :: kt ! Current time step 909 INTEGER, INTENT(in) :: kt ! Current time step 942 910 INTEGER, INTENT(in), OPTIONAL :: kindic ! flag for disabling the deallocation 943 911 ! … … 949 917 #endif 950 918 !!---------------------------------------------------------------------- 951 952 IF ( ln_asmiau ) THEN 953 954 !-------------------------------------------------------------------- 955 ! Incremental Analysis Updating 956 !-------------------------------------------------------------------- 957 919 ! 920 ! !----------------------------------------- 921 IF ( ln_asmiau ) THEN ! Incremental Analysis Updating 922 ! !----------------------------------------- 923 ! 958 924 IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN 959 925 ! 960 926 it = kt - nit000 + 1 961 927 zincwgt = wgtiau(it) ! IAU weight for the current time step 962 928 ! note this is not a tendency so should not be divided by rdt (as with the tracer and other increments) 963 929 ! 964 930 IF(lwp) THEN 965 931 WRITE(numout,*) 966 WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', & 967 & kt,' with IAU weight = ', wgtiau(it) 932 WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 968 933 WRITE(numout,*) '~~~~~~~~~~~~' 969 934 ENDIF 970 935 ! 971 936 ! Sea-ice : LIM-3 case (to add) 972 937 ! 973 938 #if defined key_lim2 974 939 ! Sea-ice : LIM-2 case … … 1008 973 1009 974 #if defined key_cice && defined key_asminc 1010 ! Sea-ice : CICE case. Zero ice increment tendency into CICE 1011 ndaice_da(:,:) = 0.0_wp 1012 #endif 1013 1014 ENDIF 1015 1016 ELSEIF ( ln_asmdin ) THEN 1017 1018 !-------------------------------------------------------------------- 1019 ! Direct Initialization 1020 !-------------------------------------------------------------------- 1021 975 ndaice_da(:,:) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 976 #endif 977 978 ENDIF 979 ! !----------------------------------------- 980 ELSEIF ( ln_asmdin ) THEN ! Direct Initialization 981 ! !----------------------------------------- 982 ! 1022 983 IF ( kt == nitdin_r ) THEN 1023 984 ! 1024 985 neuler = 0 ! Force Euler forward step 1025 986 ! 1026 987 ! Sea-ice : LIM-3 case (to add) 1027 988 ! 1028 989 #if defined key_lim2 1029 990 ! Sea-ice : LIM-2 case. … … 1041 1002 zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt 1042 1003 ELSEWHERE 1043 zhicifinc(:,:) = 0. 0_wp1004 zhicifinc(:,:) = 0._wp 1044 1005 END WHERE 1045 1006 ! … … 1050 1011 ! seaice salinity balancing (to add) 1051 1012 #endif 1052 1013 ! 1053 1014 #if defined key_cice && defined key_asminc 1054 1015 ! Sea-ice : CICE case. Pass ice increment tendency into CICE 1055 1016 ndaice_da(:,:) = seaice_bkginc(:,:) / rdt 1056 1017 #endif 1057 IF ( .NOT. PRESENT(kindic) ) THEN1058 DEALLOCATE( seaice_bkginc )1059 END IF1060 1018 IF ( .NOT. PRESENT(kindic) ) THEN 1019 DEALLOCATE( seaice_bkginc ) 1020 END IF 1021 ! 1061 1022 ELSE 1062 1023 ! 1063 1024 #if defined key_cice && defined key_asminc 1064 ! Sea-ice : CICE case. Zero ice increment tendency into CICE1065 ndaice_da(:,:) = 0.0_wp 1066 #endif 1067 1025 ndaice_da(:,:) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 1026 1027 #endif 1028 ! 1068 1029 ENDIF 1069 1030 … … 1142 1103 ! 1143 1104 !#endif 1144 1105 ! 1145 1106 ENDIF 1146 1107 ! 1147 1108 END SUBROUTINE seaice_asm_inc 1148 1109 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90
r2287 r5777 6 6 7 7 IMPLICIT NONE 8 9 !! * Routine accessibility10 8 PRIVATE 11 9 12 !! * Shared Modules variables 13 CHARACTER (LEN=40), PUBLIC, PARAMETER :: & 14 & c_asmbkg = 'assim_background_state_Jb', & !: Filename for storing the 15 !: background state for use 16 !: in the Jb term 17 & c_asmdin = 'assim_background_state_DI', & !: Filename for storing the 18 !: background state for direct 19 !: initialization 20 & c_asmtrj = 'assim_trj', & !: Filename for storing the 21 !: reference trajectory 22 & c_asminc = 'assim_background_increments' !: Filename for storing the 23 !: increments to the background 24 !: state 10 CHARACTER(LEN=40), PUBLIC, PARAMETER :: c_asmbkg = 'assim_background_state_Jb' !: Filename for storing the background state 11 ! ! for use in the Jb term 12 CHARACTER(LEN=40), PUBLIC, PARAMETER :: c_asmdin = 'assim_background_state_DI' !: Filename for storing the background state 13 ! ! for direct initialization 14 CHARACTER(LEN=40), PUBLIC, PARAMETER :: c_asmtrj = 'assim_trj' !: Filename for storing the reference trajectory 15 CHARACTER(LEN=40), PUBLIC, PARAMETER :: c_asminc = 'assim_background_increments' !: Filename for storing the increments 16 ! ! to the background state 25 17 26 INTEGER, PUBLIC :: nitbkg_r !: Background time step referenced to nit00027 INTEGER, PUBLIC :: nitdin_r !: Direct Initialization time step referenced to nit00028 INTEGER, PUBLIC :: nitiaustr_r !: IAU starting time step referenced to nit00029 INTEGER, PUBLIC :: nitiaufin_r !: IAU final time step referenced to nit00030 INTEGER, PUBLIC :: nittrjfrq !: Frequency of trajectory output for 4D-VAR18 INTEGER, PUBLIC :: nitbkg_r !: Background time step referenced to nit000 19 INTEGER, PUBLIC :: nitdin_r !: Direct Initialization time step referenced to nit000 20 INTEGER, PUBLIC :: nitiaustr_r !: IAU starting time step referenced to nit000 21 INTEGER, PUBLIC :: nitiaufin_r !: IAU final time step referenced to nit000 22 INTEGER, PUBLIC :: nittrjfrq !: Frequency of trajectory output for 4D-VAR 31 23 32 24 !!---------------------------------------------------------------------- … … 34 26 !! $Id$ 35 27 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 !!---------------------------------------------------------------------- 37 28 !!====================================================================== 38 29 END MODULE asmpar -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
r4699 r5777 8 8 !! 3.3 ! 2010-09 (D. Storkey) add ice boundary conditions 9 9 !! 3.4 ! 2011 (D. Storkey) rewrite in preparation for OBC-BDY merge 10 !! 3.6 ! 201 2-01 (C. Rousset) add ice boundary conditions for lim310 !! 3.6 ! 2014-01 (C. Rousset) add ice boundary conditions for lim3 11 11 !!---------------------------------------------------------------------- 12 12 #if defined key_bdy … … 22 22 23 23 TYPE, PUBLIC :: OBC_INDEX !: Indices and weights which define the open boundary 24 INTEGER , DIMENSION(jpbgrd) :: nblen25 INTEGER , DIMENSION(jpbgrd) :: nblenrim26 INTEGER , POINTER, DIMENSION(:,:):: nbi27 INTEGER , POINTER, DIMENSION(:,:):: nbj28 INTEGER , POINTER, DIMENSION(:,:):: nbr29 INTEGER , POINTER, DIMENSION(:,:):: nbmap30 REAL(wp) , POINTER, DIMENSION(:,:):: nbw31 REAL(wp) , POINTER, DIMENSION(:,:):: nbd32 REAL(wp) , POINTER, DIMENSION(:,:):: nbdout33 REAL(wp) , POINTER, DIMENSION(:,:):: flagu34 REAL(wp) , POINTER, DIMENSION(:,:):: flagv24 INTEGER , DIMENSION(jpbgrd) :: nblen 25 INTEGER , DIMENSION(jpbgrd) :: nblenrim 26 INTEGER , POINTER, DIMENSION(:,:) :: nbi 27 INTEGER , POINTER, DIMENSION(:,:) :: nbj 28 INTEGER , POINTER, DIMENSION(:,:) :: nbr 29 INTEGER , POINTER, DIMENSION(:,:) :: nbmap 30 REAL(wp), POINTER, DIMENSION(:,:) :: nbw 31 REAL(wp), POINTER, DIMENSION(:,:) :: nbd 32 REAL(wp), POINTER, DIMENSION(:,:) :: nbdout 33 REAL(wp), POINTER, DIMENSION(:,:) :: flagu 34 REAL(wp), POINTER, DIMENSION(:,:) :: flagv 35 35 END TYPE OBC_INDEX 36 36 … … 41 41 42 42 TYPE, PUBLIC :: OBC_DATA !: Storage for external data 43 INTEGER , DIMENSION(2):: nread44 LOGICAL :: ll_ssh45 LOGICAL :: ll_u2d46 LOGICAL :: ll_v2d47 LOGICAL :: ll_u3d48 LOGICAL :: ll_v3d49 LOGICAL :: ll_tem50 LOGICAL :: ll_sal51 REAL(wp), POINTER, DIMENSION(:) 52 REAL(wp), POINTER, DIMENSION(:) 53 REAL(wp), POINTER, DIMENSION(:) 54 REAL(wp), POINTER, DIMENSION(:,:) 55 REAL(wp), POINTER, DIMENSION(:,:) 56 REAL(wp), POINTER, DIMENSION(:,:) 57 REAL(wp), POINTER, DIMENSION(:,:) 43 INTEGER , DIMENSION(2) :: nread 44 LOGICAL :: ll_ssh 45 LOGICAL :: ll_u2d 46 LOGICAL :: ll_v2d 47 LOGICAL :: ll_u3d 48 LOGICAL :: ll_v3d 49 LOGICAL :: ll_tem 50 LOGICAL :: ll_sal 51 REAL(wp), POINTER, DIMENSION(:) :: ssh 52 REAL(wp), POINTER, DIMENSION(:) :: u2d 53 REAL(wp), POINTER, DIMENSION(:) :: v2d 54 REAL(wp), POINTER, DIMENSION(:,:) :: u3d 55 REAL(wp), POINTER, DIMENSION(:,:) :: v3d 56 REAL(wp), POINTER, DIMENSION(:,:) :: tem 57 REAL(wp), POINTER, DIMENSION(:,:) :: sal 58 58 #if defined key_lim2 59 LOGICAL ::ll_frld60 LOGICAL ::ll_hicif61 LOGICAL ::ll_hsnif62 REAL(wp), POINTER, DIMENSION(:) ::frld63 REAL(wp), POINTER, DIMENSION(:) ::hicif64 REAL(wp), POINTER, DIMENSION(:) ::hsnif59 LOGICAL :: ll_frld 60 LOGICAL :: ll_hicif 61 LOGICAL :: ll_hsnif 62 REAL(wp), POINTER, DIMENSION(:) :: frld 63 REAL(wp), POINTER, DIMENSION(:) :: hicif 64 REAL(wp), POINTER, DIMENSION(:) :: hsnif 65 65 #elif defined key_lim3 66 LOGICAL ::ll_a_i67 LOGICAL ::ll_ht_i68 LOGICAL ::ll_ht_s69 REAL , POINTER, DIMENSION(:,:) :: a_i!: now ice leads fraction climatology70 REAL , POINTER, DIMENSION(:,:) :: ht_i!: Now ice thickness climatology71 REAL , POINTER, DIMENSION(:,:) :: ht_s!: now snow thickness66 LOGICAL :: ll_a_i 67 LOGICAL :: ll_ht_i 68 LOGICAL :: ll_ht_s 69 REAL(wp), POINTER, DIMENSION(:,:) :: a_i !: now ice leads fraction climatology 70 REAL(wp), POINTER, DIMENSION(:,:) :: ht_i !: Now ice thickness climatology 71 REAL(wp), POINTER, DIMENSION(:,:) :: ht_s !: now snow thickness 72 72 #endif 73 73 END TYPE OBC_DATA … … 99 99 INTEGER, DIMENSION(jp_bdy) :: nn_tra_dta !: = 0 use the initial state as bdy dta ; 100 100 !: = 1 read it in a NetCDF file 101 LOGICAL , DIMENSION(jp_bdy) :: ln_tra_dmp!: =T Tracer damping102 LOGICAL , DIMENSION(jp_bdy) :: ln_dyn3d_dmp!: =T Baroclinic velocity damping103 REAL(wp), DIMENSION(jp_bdy) :: rn_time_dmp!: Damping time scale in days104 REAL(wp), DIMENSION(jp_bdy) :: rn_time_dmp_out!: Damping time scale in days at radiation outflow points101 LOGICAL , DIMENSION(jp_bdy) :: ln_tra_dmp !: =T Tracer damping 102 LOGICAL , DIMENSION(jp_bdy) :: ln_dyn3d_dmp !: =T Baroclinic velocity damping 103 REAL(wp), DIMENSION(jp_bdy) :: rn_time_dmp !: Damping time scale in days 104 REAL(wp), DIMENSION(jp_bdy) :: rn_time_dmp_out !: Damping time scale in days at radiation outflow points 105 105 106 106 CHARACTER(len=20), DIMENSION(jp_bdy) :: cn_ice_lim ! Choice of boundary condition for sea ice variables 107 INTEGER , DIMENSION(jp_bdy):: nn_ice_lim_dta !: = 0 use the initial state as bdy dta ;107 INTEGER , DIMENSION(jp_bdy) :: nn_ice_lim_dta !: = 0 use the initial state as bdy dta ; 108 108 !: = 1 read it in a NetCDF file 109 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_tem!: choice of the temperature of incoming sea ice110 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_sal!: choice of the salinity of incoming sea ice111 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_age!: choice of the age of incoming sea ice109 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_tem !: choice of the temperature of incoming sea ice 110 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_sal !: choice of the salinity of incoming sea ice 111 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_age !: choice of the age of incoming sea ice 112 112 ! 113 113 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
r5656 r5777 59 59 !! 60 60 !!---------------------------------------------------------------------- 61 INTEGER, INTENT( in ) :: kt ! Main time step counter 62 INTEGER :: ib_bdy ! Loop index 63 61 INTEGER, INTENT( in ) :: kt ! Main time step counter 62 ! 63 INTEGER :: ib_bdy ! Loop index 64 !!---------------------------------------------------------------------- 65 ! 64 66 #if defined key_lim3 65 67 CALL lim_var_glo2eqv 66 68 #endif 67 69 ! 68 70 DO ib_bdy=1, nb_bdy 69 71 ! 70 72 SELECT CASE( cn_ice_lim(ib_bdy) ) 71 73 CASE('none') … … 76 78 CALL ctl_stop( 'bdy_ice_lim : unrecognised option for open boundaries for ice fields' ) 77 79 END SELECT 78 80 ! 79 81 END DO 80 82 ! 81 83 #if defined key_lim3 82 84 CALL lim_var_zapsmall 83 85 CALL lim_var_agg(1) 84 86 #endif 85 87 ! 86 88 END SUBROUTINE bdy_ice_lim 89 87 90 88 91 SUBROUTINE bdy_ice_frs( idx, dta, kt, ib_bdy ) … … 96 99 !! dimensional baroclinic ocean model with realistic topography. Tellus, 365-382. 97 100 !!------------------------------------------------------------------------------ 98 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices99 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data100 INTEGER, INTENT(in) :: kt ! main time-step counter101 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 102 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 103 INTEGER, INTENT(in) :: kt ! main time-step counter 101 104 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 102 105 ! 103 106 INTEGER :: jpbound ! 0 = incoming ice 104 107 ! ! 1 = outgoing ice 105 108 INTEGER :: jb, jk, jgrd, jl ! dummy loop indices 106 109 INTEGER :: ji, jj, ii, ij ! local scalar … … 111 114 USE ice_2, vt_i => hicm 112 115 #endif 113 114 !!------------------------------------------------------------------------------ 115 ! 116 IF( nn_timing == 1 ) CALL timing_start('bdy_ice_frs') 116 !!------------------------------------------------------------------------------ 117 ! 118 IF( nn_timing == 1 ) CALL timing_start('bdy_ice_frs') 117 119 ! 118 120 jgrd = 1 ! Everything is at T-points here … … 181 183 ! condition on ice thickness depends on the ice velocity 182 184 ! if velocity is outward (strictly), then ice thickness, volume... must be equal to adjacent values 183 jpbound = 0 ; ii = ji; ij = jj;184 185 jpbound = 0 ; ii = ji ; ij = jj 186 ! 185 187 IF( u_ice(ji+1,jj ) < 0. .AND. umask(ji-1,jj ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj 186 188 IF( u_ice(ji-1,jj ) > 0. .AND. umask(ji+1,jj ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj 187 189 IF( v_ice(ji ,jj+1) < 0. .AND. vmask(ji ,jj-1,1) == 0. ) jpbound = 1; ii = ji ; ij = jj+1 188 190 IF( v_ice(ji ,jj-1) > 0. .AND. vmask(ji ,jj+1,1) == 0. ) jpbound = 1; ii = ji ; ij = jj-1 189 191 ! 190 192 IF( nn_ice_lim_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj ! case ice boundaries = initial conditions 191 ! do not make state variables dependent on velocity 192 193 193 ! ! do not make state variables dependent on velocity 194 ! 194 195 rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ii,ij) - 0.01 ) ) ! 0 if no ice 195 196 ! 196 197 ! concentration and thickness 197 198 a_i (ji,jj,jl) = a_i (ii,ij,jl) * rswitch 198 199 ht_i(ji,jj,jl) = ht_i(ii,ij,jl) * rswitch 199 200 ht_s(ji,jj,jl) = ht_s(ii,ij,jl) * rswitch 200 201 ! 201 202 ! Ice and snow volumes 202 203 v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) 203 204 v_s(ji,jj,jl) = ht_s(ji,jj,jl) * a_i(ji,jj,jl) 204 205 ! 205 206 SELECT CASE( jpbound ) 206 207 CASE( 0 ) ! velocity is inward208 207 ! 208 CASE( 0 ) ! velocity is inward 209 ! 209 210 ! Ice salinity, age, temperature 210 211 sm_i(ji,jj,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin … … 218 219 s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin 219 220 END DO 220 221 CASE( 1 ) ! velocity is outward222 221 ! 222 CASE( 1 ) ! velocity is outward 223 ! 223 224 ! Ice salinity, age, temperature 224 225 sm_i(ji,jj,jl) = rswitch * sm_i(ii,ij,jl) + ( 1.0 - rswitch ) * rn_simin … … 232 233 s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rn_simin 233 234 END DO 234 235 ! 235 236 END SELECT 236 237 ! if salinity is constant, then overwrite rn_ice_sal 238 IF( nn_icesal == 1 ) THEN 239 sm_i(ji,jj,jl) = rn_icesal 237 ! 238 IF( nn_icesal == 1 ) THEN ! constant salinity : overwrite rn_ice_sal 239 sm_i(ji,jj ,jl) = rn_icesal 240 240 s_i (ji,jj,:,jl) = rn_icesal 241 241 ENDIF 242 242 ! 243 243 ! contents 244 244 smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) … … 259 259 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) * r1_nlay_i 260 260 END DO 261 261 ! 262 262 END DO 263 263 ! 264 264 CALL lbc_bdy_lnk( a_i(:,:,jl), 'T', 1., ib_bdy ) 265 265 CALL lbc_bdy_lnk( ht_i(:,:,jl), 'T', 1., ib_bdy ) … … 267 267 CALL lbc_bdy_lnk( v_i(:,:,jl), 'T', 1., ib_bdy ) 268 268 CALL lbc_bdy_lnk( v_s(:,:,jl), 'T', 1., ib_bdy ) 269 269 ! 270 270 CALL lbc_bdy_lnk( smv_i(:,:,jl), 'T', 1., ib_bdy ) 271 271 CALL lbc_bdy_lnk( sm_i(:,:,jl), 'T', 1., ib_bdy ) … … 280 280 CALL lbc_bdy_lnk(e_i(:,:,jk,jl), 'T', 1., ib_bdy ) 281 281 END DO 282 282 ! 283 283 END DO !jl 284 284 ! 285 285 #endif 286 286 ! 287 IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_frs')287 IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_frs') 288 288 ! 289 289 END SUBROUTINE bdy_ice_frs … … 300 300 !! 2013-06 : C. Rousset 301 301 !!------------------------------------------------------------------------------ 302 !!303 302 CHARACTER(len=1), INTENT(in) :: cd_type ! nature of velocity grid-points 303 ! 304 304 INTEGER :: jb, jgrd ! dummy loop indices 305 305 INTEGER :: ji, jj ! local scalar 306 306 INTEGER :: ib_bdy ! Loop index 307 307 REAL(wp) :: zmsk1, zmsk2, zflag 308 !!------------------------------------------------------------------------------308 !!------------------------------------------------------------------------------ 309 309 ! 310 310 IF( nn_timing == 1 ) CALL timing_start('bdy_ice_lim_dyn') … … 313 313 ! 314 314 SELECT CASE( cn_ice_lim(ib_bdy) ) 315 315 ! 316 316 CASE('none') 317 318 317 CYCLE 319 318 ! 320 319 CASE('frs') 321 320 ! 322 321 IF( nn_ice_lim_dta(ib_bdy) == 0 ) CYCLE ! case ice boundaries = initial conditions 323 ! do not change ice velocity (it is only computed by rheology) 324 322 ! ! do not change ice velocity (it is only computed by rheology) 325 323 SELECT CASE ( cd_type ) 326 327 CASE ( 'U' ) 328 324 ! 325 CASE ( 'U' ) 329 326 jgrd = 2 ! u velocity 330 327 DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd) … … 332 329 jj = idx_bdy(ib_bdy)%nbj(jb,jgrd) 333 330 zflag = idx_bdy(ib_bdy)%flagu(jb,jgrd) 334 331 ! 335 332 IF ( ABS( zflag ) == 1. ) THEN ! eastern and western boundaries 336 333 ! one of the two zmsk is always 0 (because of zflag) 337 334 zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji+1,jj) ) ) ! 0 if no ice 338 335 zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji-1,jj) ) ) ! 0 if no ice 339 336 ! 340 337 ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce) 341 338 u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & … … 349 346 rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01_wp ) ) ! 0 if no ice 350 347 u_ice(ji,jj) = rswitch * u_ice(ji,jj) 351 352 ENDDO 353 348 ! 349 END DO 354 350 CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy ) 355 351 ! 356 352 CASE ( 'V' ) 357 358 353 jgrd = 3 ! v velocity 359 354 DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd) … … 361 356 jj = idx_bdy(ib_bdy)%nbj(jb,jgrd) 362 357 zflag = idx_bdy(ib_bdy)%flagv(jb,jgrd) 363 358 ! 364 359 IF ( ABS( zflag ) == 1. ) THEN ! northern and southern boundaries 365 360 ! one of the two zmsk is always 0 (because of zflag) 366 361 zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj+1) ) ) ! 0 if no ice 367 362 zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj-1) ) ) ! 0 if no ice 368 363 ! 369 364 ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce) 370 365 v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & … … 378 373 rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01 ) ) ! 0 if no ice 379 374 v_ice(ji,jj) = rswitch * v_ice(ji,jj) 380 381 ENDDO 382 375 ! 376 END DO 383 377 CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy ) 384 378 ! 385 379 END SELECT 386 380 ! 387 381 CASE DEFAULT 388 382 CALL ctl_stop( 'bdy_ice_lim_dyn : unrecognised option for open boundaries for ice fields' ) 389 383 END SELECT 390 391 END DO392 384 ! 385 END DO 386 ! 393 387 IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_lim_dyn') 394 388 ! 395 389 END SUBROUTINE bdy_ice_lim_dyn 396 390 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r5656 r5777 76 76 INTEGER :: ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices 77 77 INTEGER :: icount, icountr, ibr_max, ilen1, ibm1 ! local integers 78 INTEGER :: iwe, ies, iso, ino, inum, id_dummy 78 INTEGER :: iwe, ies, iso, ino, inum, id_dummy ! - - 79 79 INTEGER :: igrd_start, igrd_end, jpbdta ! - - 80 80 INTEGER :: jpbdtau, jpbdtas ! - - -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
r5737 r5777 15 15 !! 'key_dynspg_flt' filtered free surface 16 16 !!---------------------------------------------------------------------- 17 USE timing ! Timing18 17 USE oce ! ocean dynamics and tracers 19 USE sbcisf ! ice shelf 18 USE bdy_oce ! ocean open boundary conditions 19 USE sbc_oce ! ocean surface boundary conditions 20 20 USE dom_oce ! ocean space and time domain 21 21 USE phycst ! physical constants 22 USE bdy_oce ! ocean open boundary conditions 22 USE sbcisf ! ice shelf 23 ! 24 USE in_out_manager ! I/O manager 23 25 USE lib_mpp ! for mppsum 24 USE in_out_manager ! I/O manager25 USE sbc_oce ! ocean surface boundary conditions26 USE timing ! Timing 27 USE lib_fortran ! Fortran routines library 26 28 27 29 IMPLICIT NONE … … 33 35 # include "domzgr_substitute.h90" 34 36 !!---------------------------------------------------------------------- 35 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)37 !! NEMO/OPA 3.6 , NEMO Consortium (2014) 36 38 !! $Id$ 37 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 78 80 TYPE(OBC_INDEX), POINTER :: idx 79 81 !!----------------------------------------------------------------------------- 80 81 IF( nn_timing == 1 ) CALL timing_start('bdy_vol')82 82 ! 83 IF( nn_timing == 1 ) CALL timing_start('bdy_vol') 84 ! 83 85 IF( ln_vol ) THEN 84 86 ! 85 87 IF( kt == nit000 ) THEN 86 88 IF(lwp) WRITE(numout,*) … … 91 93 ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain 92 94 ! ----------------------------------------------------------------------- 95 !!gm replace these lines : 93 96 z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 94 97 IF( lk_mpp ) CALL mpp_sum( z_cflxemp ) ! sum over the global domain 98 !!gm by : 99 !!gm z_cflxemp = glob_sum( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 100 !!gm 95 101 96 102 ! Transport through the unstructured open boundary 97 103 ! ------------------------------------------------ 98 zubtpecor = 0. e0104 zubtpecor = 0._wp 99 105 DO ib_bdy = 1, nb_bdy 100 106 idx => idx_bdy(ib_bdy) 101 107 ! 102 108 jgrd = 2 ! cumulate u component contribution first 103 109 DO jb = 1, idx%nblenrim(jgrd) … … 116 122 END DO 117 123 END DO 118 124 ! 119 125 END DO 120 126 IF( lk_mpp ) CALL mpp_sum( zubtpecor ) ! sum over the global domain … … 123 129 ! ------------------------------ 124 130 IF( nn_volctl==1 ) THEN ; zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot 125 ELSE ; zubtpecor = zubtpecor / bdysurftot131 ELSE ; zubtpecor = zubtpecor / bdysurftot 126 132 END IF 127 133 128 134 ! Correction of the total velocity on the unstructured boundary to respect the mass flux conservation 129 135 ! ------------------------------------------------------------- 130 ztranst = 0. e0136 ztranst = 0._wp 131 137 DO ib_bdy = 1, nb_bdy 132 138 idx => idx_bdy(ib_bdy) 133 139 ! 134 140 jgrd = 2 ! correct u component 135 141 DO jb = 1, idx%nblenrim(jgrd) … … 150 156 END DO 151 157 END DO 152 158 ! 153 159 END DO 154 160 IF( lk_mpp ) CALL mpp_sum( ztranst ) ! sum over the global domain … … 169 175 ! 170 176 END IF ! ln_vol 171 177 ! 172 178 END SUBROUTINE bdy_vol 173 179 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90
r5215 r5777 48 48 !!---------------------------------------------------------------------- 49 49 ! 50 51 50 REWIND( numnam_ref ) ! Namelist namc1d in reference namelist : Tracer advection scheme 52 51 READ ( numnam_ref, namc1d, IOSTAT = ios, ERR = 901) … … 57 56 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d in configuration namelist', lwp ) 58 57 IF(lwm) WRITE ( numond, namc1d ) 59 60 58 ! 61 59 IF(lwp) THEN ! Control print … … 69 67 ENDIF 70 68 ! 71 !72 69 END SUBROUTINE c1d_init 73 70 … … 77 74 !!---------------------------------------------------------------------- 78 75 USE par_kind ! kind parameters 79 80 76 LOGICAL, PUBLIC, PARAMETER :: lk_c1d = .FALSE. !: 1D config. flag de-activated 81 77 REAL(wp) :: rn_lat1d, rn_lon1d 82 78 LOGICAL , PUBLIC :: ln_c1d_locpt = .FALSE. 83 84 79 CONTAINS 85 86 80 SUBROUTINE c1d_init ! Dummy routine 87 81 END SUBROUTINE c1d_init 88 89 82 #endif 90 83 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r5758 r5777 165 165 CALL iom_put( "eken", rke_crs ) 166 166 167 ! Horizontal divergence ( following OPA_SRC/DYN/div cur.F90 )167 ! Horizontal divergence ( following OPA_SRC/DYN/divhor.F90 ) 168 168 DO jk = 1, jpkm1 169 169 DO ji = 2, jpi_crsm1 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r5737 r5777 7 7 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 8 8 !!---------------------------------------------------------------------- 9 #if defined key_diaar5 || defined key_esopa9 #if defined key_diaar5 10 10 !!---------------------------------------------------------------------- 11 11 !! 'key_diaar5' : activate ar5 diagnotics -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
r5363 r5777 8 8 !! ! 1997-08 (G. Madec) optimization 9 9 !! ! 1999-07 (E. Guilyardi) hd28 + heat content 10 !! 8.5! 2002-06 (G. Madec) F90: Free form and module11 !! NEMO3.2 ! 2009-07 (S. Masson) hc300 bugfix + cleaning + add new diag12 !!---------------------------------------------------------------------- 13 #if defined key_diahth || defined key_esopa10 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 11 !! 3.2 ! 2009-07 (S. Masson) hc300 bugfix + cleaning + add new diag 12 !!---------------------------------------------------------------------- 13 #if defined key_diahth 14 14 !!---------------------------------------------------------------------- 15 15 !! 'key_diahth' : thermocline depth diag. -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r5758 r5777 29 29 USE dynadv, ONLY: ln_dynadv_vec 30 30 USE zdf_oce ! ocean vertical physics 31 USE ldftra ! ocean active tracers: lateral physics 32 USE ldfdyn_oce ! ocean dynamics: lateral physics 31 USE ldftra ! lateral physics: eddy diffusivity coef. 33 32 USE sol_oce ! solver variables 34 33 USE sbc_oce ! Surface boundary condition: ocean fields … … 402 401 !! Each nwrite time step, output the instantaneous or mean fields 403 402 !!---------------------------------------------------------------------- 404 !! 405 INTEGER, INTENT( in ) :: kt ! ocean time-step index 406 !! 403 INTEGER, INTENT( in ) :: kt ! ocean time-step index 404 ! 407 405 LOGICAL :: ll_print = .FALSE. ! =T print and flush numout 408 406 CHARACTER (len=40) :: clhstnam, clop, clmx ! local names … … 872 870 !!---------------------------------------------------------------------- 873 871 ! 874 ! IF( nn_timing == 1 ) CALL timing_start('dia_wri_state') ! not sure this works for routines not called in first timestep875 876 872 ! 0. Initialisation 877 873 ! ----------------- … … 974 970 ENDIF 975 971 #endif 976 977 ! IF( nn_timing == 1 ) CALL timing_stop('dia_wri_state') ! not sure this works for routines not called in first timestep978 972 ! 979 973 END SUBROUTINE dia_wri_state -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
r5506 r5777 71 71 !! =2 put at location runoff 72 72 !!---------------------------------------------------------------------- 73 INTEGER :: jc 74 INTEGER :: isrow! local index75 !!---------------------------------------------------------------------- 76 73 INTEGER :: jc ! dummy loop indices 74 INTEGER :: isrow ! local index 75 !!---------------------------------------------------------------------- 76 ! 77 77 IF(lwp) WRITE(numout,*) 78 78 IF(lwp) WRITE(numout,*)'dom_clo : closed seas ' 79 79 IF(lwp) WRITE(numout,*)'~~~~~~~' 80 80 ! 81 81 ! initial values 82 82 ncsnr(:) = 1 ; ncsi1(:) = 1 ; ncsi2(:) = 1 ; ncsir(:,:) = 1 83 83 ncstt(:) = 0 ; ncsj1(:) = 1 ; ncsj2(:) = 1 ; ncsjr(:,:) = 1 84 84 ! 85 85 ! set the closed seas (in data domain indices) 86 86 ! ------------------- 87 87 ! 88 88 IF( cp_cfg == "orca" ) THEN 89 89 ! -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r5770 r5777 19 19 !! dom_nam : read and contral domain namelists 20 20 !! dom_ctl : control print for the ocean domain 21 !! dom_stiff : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate) 21 22 !!---------------------------------------------------------------------- 22 23 USE oce ! ocean variables … … 25 26 USE phycst ! physical constants 26 27 USE closea ! closed seas 27 USE in_out_manager ! I/O manager28 USE lib_mpp ! distributed memory computing library29 30 28 USE domhgr ! domain: set the horizontal mesh 31 29 USE domzgr ! domain: set the vertical mesh … … 36 34 USE c1d ! 1D vertical configuration 37 35 USE dyncor_c1d ! Coriolis term (c1d case) (cor_c1d routine) 36 ! 37 USE in_out_manager ! I/O manager 38 USE lib_mpp ! distributed memory computing library 39 USE lbclnk ! ocean lateral boundary condition (or mpp link) 38 40 USE timing ! Timing 39 USE lbclnk ! ocean lateral boundary condition (or mpp link)40 41 41 42 IMPLICIT NONE … … 88 89 IF( ln_sco ) CALL dom_stiff ! Maximum stiffness ratio/hydrostatic consistency 89 90 ! 90 ht_0(:,:) = 0. 0_wp! Reference ocean depth at T-points91 hu_0(:,:) = 0. 0_wp! Reference ocean depth at U-points92 hv_0(:,:) = 0. 0_wp! Reference ocean depth at V-points91 ht_0(:,:) = 0._wp ! Reference ocean depth at T-points 92 hu_0(:,:) = 0._wp ! Reference ocean depth at U-points 93 hv_0(:,:) = 0._wp ! Reference ocean depth at V-points 93 94 DO jk = 1, jpk 94 95 ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) … … 97 98 END DO 98 99 ! 99 IF( lk_vvl )CALL dom_vvl_init ! Vertical variable mesh100 IF( lk_vvl ) CALL dom_vvl_init ! Vertical variable mesh 100 101 ! 101 102 IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point … … 153 154 REWIND( numnam_ref ) ! Namelist namrun in reference namelist : Parameters of the run 154 155 READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) 155 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )156 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp ) 156 157 157 158 REWIND( numnam_cfg ) ! Namelist namrun in configuration namelist : Parameters of the run 158 159 READ ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 ) 159 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )160 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp ) 160 161 IF(lwm) WRITE ( numond, namrun ) 161 162 ! … … 249 250 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 250 251 IF(lwm) WRITE ( numond, namdom ) 251 252 ! 252 253 IF(lwp) THEN 253 254 WRITE(numout,*) … … 291 292 WRITE(numout,*) ' ppacr2 = ', ppacr2 292 293 ENDIF 293 294 ! 294 295 ntopo = nn_bathy ! conversion DOCTOR names into model names (this should disappear soon) 295 296 e3zps_min = rn_e3zps_min … … 385 386 END SUBROUTINE dom_ctl 386 387 388 387 389 SUBROUTINE dom_stiff 388 390 !!---------------------------------------------------------------------- … … 403 405 REAL(wp), DIMENSION(4) :: zr1 404 406 !!---------------------------------------------------------------------- 405 rx1(:,:) = 0. e0406 zrxmax = 0. e0407 zr1(:) = 0. e0408 407 rx1(:,:) = 0._wp 408 zrxmax = 0._wp 409 zr1(:) = 0._wp 410 ! 409 411 DO ji = 2, jpim1 410 412 DO jj = 2, jpjm1 … … 431 433 END DO 432 434 END DO 433 434 435 CALL lbc_lnk( rx1, 'T', 1. ) 435 436 zrxmax = MAXVAL( rx1)437 436 ! 437 zrxmax = MAXVAL( rx1 ) 438 ! 438 439 IF( lk_mpp ) CALL mpp_max( zrxmax ) ! max over the global domain 439 440 ! 440 441 IF(lwp) THEN 441 442 WRITE(numout,*) … … 443 444 WRITE(numout,*) '~~~~~~~~~' 444 445 ENDIF 445 446 ! 446 447 END SUBROUTINE dom_stiff 447 448 449 448 450 449 !!====================================================================== -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
r5770 r5777 7 7 !! 8.1 ! 1999-11 (M. Imbard) NetCDF FORMAT with IOIPSL 8 8 !! NEMO 1.0 ! 2002-08 (G. Madec) F90 and several file 9 !! 3.0 ! 2008-01 (S. Masson) add dom_uniq 10 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 9 !! 3.0 ! 2008-01 (S. Masson) add dom_uniq 11 10 !!---------------------------------------------------------------------- 12 11 13 12 !!---------------------------------------------------------------------- 14 13 !! dom_wri : create and write mesh and mask file(s) 15 !! dom_uniq : 14 !! dom_uniq : identify unique point of a grid (TUVF) 16 15 !!---------------------------------------------------------------------- 17 16 USE dom_oce ! ocean space and time domain -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r5770 r5777 29 29 USE daymod ! calendar 30 30 USE eosbn2 ! eq. of state, Brunt Vaisala frequency (eos routine) 31 USE ldftra ! ocean active tracers: lateral physics31 USE ldftra ! lateral physics: ocean active tracers 32 32 USE zdf_oce ! ocean vertical physics 33 33 USE phycst ! physical constants … … 74 74 ! 75 75 76 IF(lwp) WRITE(numout,*) ' '76 IF(lwp) WRITE(numout,*) 77 77 IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers' 78 78 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 79 79 80 CALL dta_tsd_init! Initialisation of T & S input data81 IF( lk_c1d ) CALL dta_uvd_init! Initialization of U & V input data80 CALL dta_tsd_init ! Initialisation of T & S input data 81 IF( lk_c1d ) CALL dta_uvd_init ! Initialization of U & V input data 82 82 83 83 rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk … … 101 101 ub (:,:,:) = 0._wp ; un (:,:,:) = 0._wp 102 102 vb (:,:,:) = 0._wp ; vn (:,:,:) = 0._wp 103 rotb (:,:,:) = 0._wp ; rotn (:,:,:) = 0._wp 104 hdivb(:,:,:) = 0._wp ; hdivn(:,:,:) = 0._wp 103 hdivn(:,:,:) = 0._wp 105 104 ! 106 105 IF( cp_cfg == 'eel' ) THEN … … 150 149 ! 151 150 ! 152 un_b(:,:) = 0._wp ;vn_b(:,:) = 0._wp153 ub_b(:,:) = 0._wp ;vb_b(:,:) = 0._wp151 un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp 152 ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp 154 153 ! 155 154 DO jk = 1, jpkm1 … … 189 188 !! References : Philander ??? 190 189 !!---------------------------------------------------------------------- 191 INTEGER :: ji, jj, jk192 REAL(wp) :: zsal = 35.50 190 INTEGER :: ji, jj, jk 191 REAL(wp) :: zsal = 35.50_wp 193 192 !!---------------------------------------------------------------------- 194 193 ! … … 220 219 !! and relative vorticity fields 221 220 !!---------------------------------------------------------------------- 222 USE div cur ! hor. divergence & rel. vorticity (div_cur routine)221 USE divhor ! hor. divergence (div_hor routine) 223 222 USE iom 224 223 ! … … 269 268 tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 270 269 ! 271 ! set the dynamics: U,V, hdiv , rot(and ssh if necessary)270 ! set the dynamics: U,V, hdiv (and ssh if necessary) 272 271 ! ---------------- 273 272 ! Start EEL5 configuration with barotropic geostrophic velocities … … 305 304 ENDIF 306 305 ! 307 CALL div_cur( nit000 ) ! horizontal divergence and relative vorticity (curl) 306 !!gm Check here call to div_hor should not be necessary 307 !!gm div_hor call runoffs not sure they are defined at that level 308 CALL div_hor( nit000 ) ! horizontal divergence and relative vorticity (curl) 308 309 ! N.B. the vertical velocity will be computed from the horizontal divergence field 309 310 ! in istate by a call to wzv routine … … 358 359 !! 359 360 !! ** Method : - set temprature field 360 !! - set salinity field361 !! - set salinity field 361 362 !!---------------------------------------------------------------------- 362 363 INTEGER :: ji, jj, jk ! dummy loop indices … … 445 446 !!---------------------------------------------------------------------- 446 447 USE dynspg ! surface pressure gradient (dyn_spg routine) 447 USE div cur ! hor. divergence & rel. vorticity (div_cur routine)448 USE divhor ! hor. divergence (div_hor routine) 448 449 USE lbclnk ! ocean lateral boundary condition (or mpp link) 449 450 ! … … 531 532 indic = 0 532 533 CALL dyn_spg( nit000, indic ) ! surface pressure gradient 533 534 ! 534 535 ! the new velocity is ua*rdt 535 536 ! 536 537 CALL lbc_lnk( ua, 'U', -1. ) 537 538 CALL lbc_lnk( va, 'V', -1. ) … … 543 544 un(:,:,:) = ub(:,:,:) 544 545 vn(:,:,:) = vb(:,:,:) 545 546 ! Compute the divergence and curl 547 548 CALL div_cur( nit000 ) ! now horizontal divergence and curl 549 550 hdivb(:,:,:) = hdivn(:,:,:) ! set the before to the now value 551 rotb (:,:,:) = rotn (:,:,:) ! set the before to the now value 546 ! 547 !!gm Check here call to div_hor should not be necessary 548 !!gm div_hor call runoffs not sure they are defined at that level 549 CALL div_hor( nit000 ) ! now horizontal divergence 552 550 ! 553 551 CALL wrk_dealloc( jpi,jpj,jpk, zprn) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90
r5775 r5777 1 MODULE div cur1 MODULE divhor 2 2 !!============================================================================== 3 !! *** MODULE div cur ***4 !! Ocean diagnostic variable : horizontal divergence and relative vorticity3 !! *** MODULE divhor *** 4 !! Ocean diagnostic variable : now horizontal divergence 5 5 !!============================================================================== 6 !! History : OPA ! 1987-06 (P. Andrich, D. L Hostis) Original code 7 !! 4.0 ! 1991-11 (G. Madec) 8 !! 6.0 ! 1993-03 (M. Guyon) symetrical conditions 9 !! 7.0 ! 1996-01 (G. Madec) s-coordinates 10 !! 8.0 ! 1997-06 (G. Madec) lateral boundary cond., lbc 11 !! 8.1 ! 1997-08 (J.M. Molines) Open boundaries 12 !! 8.2 ! 2000-03 (G. Madec) no slip accurate 13 !! NEMO 1.0 ! 2002-09 (G. Madec, E. Durand) Free form, F90 6 !! History : 1.0 ! 2002-09 (G. Madec, E. Durand) Free form, F90 14 7 !! - ! 2005-01 (J. Chanut) Unstructured open boundaries 15 8 !! - ! 2003-08 (G. Madec) merged of cur and div, free form, F90 … … 17 10 !! 3.3 ! 2010-09 (D.Storkey and E.O'Dea) bug fixes for BDY module 18 11 !! - ! 2010-10 (R. Furner, G. Madec) runoff and cla added directly here 19 !! 3.6 ! 2014-11 (P. Mathiot) isf added directly here 20 !! 3.7 ! 2015-10 (G. Madec) remove cross-land advection 12 !! 3.7 ! 2014-01 (G. Madec) suppression of velocity curl from in-core memory 13 !! - ! 2014-12 (G. Madec) suppression of cross land advection option 14 !! - ! 2015-10 (G. Madec) add velocity and rnf flag in argument of div_hor 21 15 !!---------------------------------------------------------------------- 22 16 23 17 !!---------------------------------------------------------------------- 24 !! div_cur : Compute the horizontal divergence and relative 25 !! vorticity fields 18 !! div_hor : Compute the horizontal divergence field 26 19 !!---------------------------------------------------------------------- 27 20 USE oce ! ocean dynamics and tracers … … 29 22 USE sbc_oce, ONLY : ln_rnf, nn_isf ! surface boundary condition: ocean 30 23 USE sbcrnf ! river runoff 31 USE sbcisf ! ice shelf 24 USE sbcisf ! ice shelf 25 ! 32 26 USE in_out_manager ! I/O manager 33 27 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 39 33 PRIVATE 40 34 41 PUBLIC div_ cur ! routine called by step.F90 and istate.F9035 PUBLIC div_hor ! routine called by step.F90 and istate.F90 42 36 43 37 !! * Substitutions … … 45 39 # include "vectopt_loop_substitute.h90" 46 40 !!---------------------------------------------------------------------- 47 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)41 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 48 42 !! $Id$ 49 43 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 51 45 CONTAINS 52 46 53 #if defined key_noslip_accurate 54 !!---------------------------------------------------------------------- 55 !! 'key_noslip_accurate' 2nd order interior + 4th order at the coast 56 !!---------------------------------------------------------------------- 57 58 SUBROUTINE div_cur( kt ) 47 SUBROUTINE div_hor( kt ) 59 48 !!---------------------------------------------------------------------- 60 !! *** ROUTINE div_cur *** 49 !! *** ROUTINE div_hor *** 50 !! 51 !! ** Purpose : compute the horizontal divergence at now time-step 61 52 !! 62 !! ** Purpose : compute the horizontal divergence and the relative 63 !! vorticity at before and now time-step 53 !! ** Method : the now divergence is computed as : 54 !! hdivn = 1/(e1e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 55 !! and correct with runoff inflow (div_rnf) and cross land flow (div_cla) 64 56 !! 65 !! ** Method : I. divergence : 66 !! - save the divergence computed at the previous time-step 67 !! (note that the Asselin filter has not been applied on hdivb) 68 !! - compute the now divergence given by : 69 !! hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 70 !! correct hdiv with runoff inflow (div_rnf) and ice shelf melting (div_isf) 71 !! II. vorticity : 72 !! - save the curl computed at the previous time-step 73 !! rotb = rotn 74 !! (note that the Asselin time filter has not been applied to rotb) 75 !! - compute the now curl in tensorial formalism: 76 !! rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] ) 77 !! - Coastal boundary condition: 'key_noslip_accurate' defined, 78 !! the no-slip boundary condition is computed using Schchepetkin 79 !! and O'Brien (1996) scheme (i.e. 4th order at the coast). 80 !! For example, along east coast, the one-sided finite difference 81 !! approximation used for di[v] is: 82 !! di[e2v vn] = 1/(e1f*e2f) * ( (e2v vn)(i) + (e2v vn)(i-1) + (e2v vn)(i-2) ) 83 !! 84 !! ** Action : - update hdivb, hdivn, the before & now hor. divergence 85 !! - update rotb , rotn , the before & now rel. vorticity 86 !!---------------------------------------------------------------------- 87 INTEGER, INTENT(in) :: kt ! ocean time-step index 88 ! 89 INTEGER :: ji, jj, jk, jl ! dummy loop indices 90 INTEGER :: ii, ij, ijt, iju, ierr ! local integer 91 REAL(wp) :: zraur, zdep ! local scalar 92 REAL(wp), POINTER, DIMENSION(:,:) :: zwu ! specific 2D workspace 93 REAL(wp), POINTER, DIMENSION(:,:) :: zwv ! specific 2D workspace 94 !!---------------------------------------------------------------------- 95 ! 96 IF( nn_timing == 1 ) CALL timing_start('div_cur') 97 ! 98 CALL wrk_alloc( jpi , jpj+2, zwu ) 99 CALL wrk_alloc( jpi+4, jpj , zwv, kistart = -1 ) 100 ! 101 IF( kt == nit000 ) THEN 102 IF(lwp) WRITE(numout,*) 103 IF(lwp) WRITE(numout,*) 'div_cur : horizontal velocity divergence and relative vorticity' 104 IF(lwp) WRITE(numout,*) '~~~~~~~ NOT optimal for auto-tasking case' 105 ENDIF 106 107 ! ! =============== 108 DO jk = 1, jpkm1 ! Horizontal slab 109 ! ! =============== 110 ! 111 hdivb(:,:,jk) = hdivn(:,:,jk) ! time swap of div arrays 112 rotb (:,:,jk) = rotn (:,:,jk) ! time swap of rot arrays 113 ! 114 ! ! -------- 115 ! Horizontal divergence ! div 116 ! ! -------- 117 DO jj = 2, jpjm1 118 DO ji = fs_2, fs_jpim1 ! vector opt. 119 hdivn(ji,jj,jk) = & 120 ( e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj )*fse3u(ji-1,jj ,jk) * un(ji-1,jj ,jk) & 121 + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji ,jj-1)*fse3v(ji ,jj-1,jk) * vn(ji ,jj-1,jk) ) & 122 / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 123 END DO 124 END DO 125 126 IF( .NOT. AGRIF_Root() ) THEN 127 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , : ,jk) = 0.e0 ! east 128 IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2 , : ,jk) = 0.e0 ! west 129 IF ((nbondj == 1).OR.(nbondj == 2)) hdivn(: ,nlcj-1 ,jk) = 0.e0 ! north 130 IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(: ,2 ,jk) = 0.e0 ! south 131 ENDIF 132 133 ! ! -------- 134 ! relative vorticity ! rot 135 ! ! -------- 136 ! contravariant velocity (extended for lateral b.c.) 137 ! inside the model domain 138 DO jj = 1, jpj 139 DO ji = 1, jpi 140 zwu(ji,jj) = e1u(ji,jj) * un(ji,jj,jk) 141 zwv(ji,jj) = e2v(ji,jj) * vn(ji,jj,jk) 142 END DO 143 END DO 144 145 ! East-West boundary conditions 146 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 147 zwv( 0 ,:) = zwv(jpi-2,:) 148 zwv( -1 ,:) = zwv(jpi-3,:) 149 zwv(jpi+1,:) = zwv( 3 ,:) 150 zwv(jpi+2,:) = zwv( 4 ,:) 151 ELSE 152 zwv( 0 ,:) = 0.e0 153 zwv( -1 ,:) = 0.e0 154 zwv(jpi+1,:) = 0.e0 155 zwv(jpi+2,:) = 0.e0 156 ENDIF 157 158 ! North-South boundary conditions 159 IF( nperio == 3 .OR. nperio == 4 ) THEN 160 ! north fold ( Grid defined with a T-point pivot) ORCA 2 degre 161 zwu(jpi,jpj+1) = 0.e0 162 zwu(jpi,jpj+2) = 0.e0 163 DO ji = 1, jpi-1 164 iju = jpi - ji + 1 165 zwu(ji,jpj+1) = - zwu(iju,jpj-3) 166 zwu(ji,jpj+2) = - zwu(iju,jpj-4) 167 END DO 168 ELSEIF( nperio == 5 .OR. nperio == 6 ) THEN 169 ! north fold ( Grid defined with a F-point pivot) ORCA 0.5 degre\ 170 zwu(jpi,jpj+1) = 0.e0 171 zwu(jpi,jpj+2) = 0.e0 172 DO ji = 1, jpi-1 173 iju = jpi - ji 174 zwu(ji,jpj ) = - zwu(iju,jpj-1) 175 zwu(ji,jpj+1) = - zwu(iju,jpj-2) 176 zwu(ji,jpj+2) = - zwu(iju,jpj-3) 177 END DO 178 DO ji = -1, jpi+2 179 ijt = jpi - ji + 1 180 zwv(ji,jpj) = - zwv(ijt,jpj-2) 181 END DO 182 DO ji = jpi/2+1, jpi+2 183 ijt = jpi - ji + 1 184 zwv(ji,jpjm1) = - zwv(ijt,jpjm1) 185 END DO 186 ELSE 187 ! closed 188 zwu(:,jpj+1) = 0.e0 189 zwu(:,jpj+2) = 0.e0 190 ENDIF 191 192 ! relative vorticity (vertical component of the velocity curl) 193 DO jj = 1, jpjm1 194 DO ji = 1, fs_jpim1 ! vector opt. 195 rotn(ji,jj,jk) = ( zwv(ji+1,jj ) - zwv(ji,jj) & 196 & - zwu(ji ,jj+1) + zwu(ji,jj) ) * fmask(ji,jj,jk) * r1_e1e2f(ji,jj) 197 END DO 198 END DO 199 200 ! second order accurate scheme along straight coast 201 DO jl = 1, npcoa(1,jk) 202 ii = nicoa(jl,1,jk) 203 ij = njcoa(jl,1,jk) 204 rotn(ii,ij,jk) = r1_e1e2f(ji,jj) * ( + 4. * zwv(ii+1,ij) - zwv(ii+2,ij) + 0.2 * zwv(ii+3,ij) ) 205 END DO 206 DO jl = 1, npcoa(2,jk) 207 ii = nicoa(jl,2,jk) 208 ij = njcoa(jl,2,jk) 209 rotn(ii,ij,jk) = r1_e1e2f(ji,jj) * (-4.*zwv(ii,ij)+zwv(ii-1,ij)-0.2*zwv(ii-2,ij)) 210 END DO 211 DO jl = 1, npcoa(3,jk) 212 ii = nicoa(jl,3,jk) 213 ij = njcoa(jl,3,jk) 214 rotn(ii,ij,jk) = -r1_e1e2f(ji,jj) * ( +4. * zwu(ii,ij+1) - zwu(ii,ij+2) + 0.2 * zwu(ii,ij+3) ) 215 END DO 216 DO jl = 1, npcoa(4,jk) 217 ii = nicoa(jl,4,jk) 218 ij = njcoa(jl,4,jk) 219 rotn(ii,ij,jk) = -r1_e1e2f(ji,jj) * ( -4. * zwu(ii,ij) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) ) 220 END DO 221 ! ! =============== 222 END DO ! End of slab 223 ! ! =============== 224 225 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field) 226 IF( ln_divisf .AND. (nn_isf /= 0) ) CALL sbc_isf_div( hdivn ) ! ice shelf (update hdivn field) 227 228 ! 4. Lateral boundary conditions on hdivn and rotn 229 ! ---------------------------------=======---====== 230 CALL lbc_lnk( hdivn, 'T', 1. ) ; CALL lbc_lnk( rotn , 'F', 1. ) ! lateral boundary cond. (no sign change) 231 ! 232 CALL wrk_dealloc( jpi , jpj+2, zwu ) 233 CALL wrk_dealloc( jpi+4, jpj , zwv, kistart = -1 ) 234 ! 235 IF( nn_timing == 1 ) CALL timing_stop('div_cur') 236 ! 237 END SUBROUTINE div_cur 238 239 #else 240 !!---------------------------------------------------------------------- 241 !! Default option 2nd order centered schemes 242 !!---------------------------------------------------------------------- 243 244 SUBROUTINE div_cur( kt ) 245 !!---------------------------------------------------------------------- 246 !! *** ROUTINE div_cur *** 247 !! 248 !! ** Purpose : compute the horizontal divergence and the relative 249 !! vorticity at before and now time-step 250 !! 251 !! ** Method : - Divergence: 252 !! - save the divergence computed at the previous time-step 253 !! (note that the Asselin filter has not been applied on hdivb) 254 !! - compute the now divergence given by : 255 !! hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 256 !! correct hdiv with runoff inflow (div_rnf) 257 !! - Relavtive Vorticity : 258 !! - save the curl computed at the previous time-step (rotb = rotn) 259 !! (note that the Asselin time filter has not been applied to rotb) 260 !! - compute the now curl in tensorial formalism: 261 !! rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] ) 262 !! Note: Coastal boundary condition: lateral friction set through 263 !! the value of fmask along the coast (see dommsk.F90) and shlat 264 !! (namelist parameter) 265 !! 266 !! ** Action : - update hdivb, hdivn, the before & now hor. divergence 267 !! - update rotb , rotn , the before & now rel. vorticity 57 !! ** Action : - update hdivn, the now horizontal divergence 268 58 !!---------------------------------------------------------------------- 269 59 INTEGER, INTENT(in) :: kt ! ocean time-step index … … 273 63 !!---------------------------------------------------------------------- 274 64 ! 275 IF( nn_timing == 1 ) CALL timing_start('div_cur')65 IF( nn_timing == 1 ) CALL timing_start('div_hor') 276 66 ! 277 67 IF( kt == nit000 ) THEN 278 68 IF(lwp) WRITE(numout,*) 279 IF(lwp) WRITE(numout,*) 'div_ cur : horizontal velocity divergence and'280 IF(lwp) WRITE(numout,*) '~~~~~~~ relative vorticity'69 IF(lwp) WRITE(numout,*) 'div_hor : horizontal velocity divergence ' 70 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 281 71 ENDIF 282 283 ! ! =============== 284 DO jk = 1, jpkm1 ! Horizontal slab 285 ! ! =============== 286 ! 287 hdivb(:,:,jk) = hdivn(:,:,jk) ! time swap of div arrays 288 rotb (:,:,jk) = rotn (:,:,jk) ! time swap of rot arrays 289 ! 290 ! ! -------- 291 ! Horizontal divergence ! div 292 ! ! -------- 72 ! 73 DO jk = 1, jpkm1 !== Horizontal divergence ==! 293 74 DO jj = 2, jpjm1 294 75 DO ji = fs_2, fs_jpim1 ! vector opt. 295 hdivn(ji,jj,jk) = & 296 ( e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * un(ji-1,jj,jk) & 297 + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk) ) & 298 / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 76 hdivn(ji,jj,jk) = ( e2u(ji ,jj) * fse3u_n(ji ,jj,jk) * un(ji ,jj,jk) & 77 & - e2u(ji-1,jj) * fse3u_n(ji-1,jj,jk) * un(ji-1,jj,jk) & 78 & + e1v(ji,jj ) * fse3v_n(ji,jj ,jk) * vn(ji,jj ,jk) & 79 & - e1v(ji,jj-1) * fse3v_n(ji,jj-1,jk) * vn(ji,jj-1,jk) ) & 80 & / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 299 81 END DO 300 82 END DO 301 302 83 IF( .NOT. AGRIF_Root() ) THEN 303 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , : ,jk) = 0.e0! east304 IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2 , : ,jk) = 0.e0! west305 IF ((nbondj == 1).OR.(nbondj == 2)) hdivn(: ,nlcj-1 ,jk) = 0.e0! north306 IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(: ,2 ,jk) = 0.e0! south84 IF( nbondi == 1 .OR. nbondi == 2 ) hdivn(nlci-1, : ,jk) = 0._wp ! east 85 IF( nbondi == -1 .OR. nbondi == 2 ) hdivn( 2 , : ,jk) = 0._wp ! west 86 IF( nbondj == 1 .OR. nbondj == 2 ) hdivn( : ,nlcj-1,jk) = 0._wp ! north 87 IF( nbondj == -1 .OR. nbondj == 2 ) hdivn( : , 2 ,jk) = 0._wp ! south 307 88 ENDIF 308 309 ! ! -------- 310 ! relative vorticity ! rot 311 ! ! -------- 312 DO jj = 1, jpjm1 313 DO ji = 1, fs_jpim1 ! vector opt. 314 rotn(ji,jj,jk) = ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 315 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 316 & * fmask(ji,jj,jk) * r1_e1e2f(ji,jj) 317 END DO 318 END DO 319 ! ! =============== 320 END DO ! End of slab 321 ! ! =============== 322 323 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field) 324 IF( ln_divisf .AND. (nn_isf .GT. 0) ) CALL sbc_isf_div( hdivn ) ! ice shelf (update hdivn field) 89 END DO 325 90 ! 326 CALL lbc_lnk( hdivn, 'T', 1. ) ; CALL lbc_lnk( rotn , 'F', 1. ) ! lateral boundary cond. (no sign change)91 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) !== runoffs ==! (update hdivn field) 327 92 ! 328 IF( nn_timing == 1 ) CALL timing_stop('div_cur')93 IF( ln_divisf .AND. nn_isf > 0 ) CALL sbc_isf_div( hdivn ) !== ice shelf ==! (update hdivn field) 329 94 ! 330 END SUBROUTINE div_cur 95 CALL lbc_lnk( hdivn, 'T', 1. ) !== lateral boundary cond. ==! (no sign change) 96 ! 97 IF( nn_timing == 1 ) CALL timing_stop('div_hor') 98 ! 99 END SUBROUTINE div_hor 331 100 332 #endif333 101 !!====================================================================== 334 END MODULE div cur102 END MODULE divhor -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90
r5322 r5777 76 76 CASE ( 3 ) 77 77 CALL dyn_adv_ubs ( kt ) ! 3rd order UBS scheme 78 !79 CASE (-1 ) ! esopa: test all possibility with control print80 CALL dyn_keg ( kt, nn_dynkeg )81 CALL dyn_zad ( kt )82 CALL dyn_adv_cen2( kt )83 CALL dyn_adv_ubs ( kt )84 78 END SELECT 85 79 ! … … 126 120 IF( ln_dynadv_cen2 ) ioptio = ioptio + 1 127 121 IF( ln_dynadv_ubs ) ioptio = ioptio + 1 128 IF( lk_esopa ) ioptio = 1129 122 130 123 IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist namdyn_adv' ) … … 139 132 IF( ln_dynadv_cen2 ) nadv = 2 140 133 IF( ln_dynadv_ubs ) nadv = 3 141 IF( lk_esopa ) nadv = -1142 134 143 135 IF(lwp) THEN ! Print the choice … … 151 143 IF( nadv == 2 ) WRITE(numout,*) ' flux form : 2nd order scheme is used' 152 144 IF( nadv == 3 ) WRITE(numout,*) ' flux form : UBS scheme is used' 153 IF( nadv == -1 ) WRITE(numout,*) ' esopa test: use all advection formulation'154 145 ENDIF 155 146 ! -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
r5758 r5777 4 4 !! Ocean physics: lateral diffusivity trends 5 5 !!===================================================================== 6 !! History : 9.0 ! 05-11 (G. Madec) Original code (new step architecture) 6 !! History : 2.0 ! 2005-11 (G. Madec) Original code (new step architecture) 7 !! 3.7 ! 2014-01 (F. Lemarie, G. Madec) restructuration/simplification of ahm specification, 8 !! ! add velocity dependent coefficient and optional read in file 7 9 !!---------------------------------------------------------------------- 8 10 … … 14 16 USE dom_oce ! ocean space and time domain 15 17 USE phycst ! physical constants 16 USE ldfdyn_oce ! ocean dynamics lateral physics 17 USE ldftra ! ocean tracers lateral physics 18 USE ldfslp ! lateral mixing: slopes of mixing orientation 19 USE dynldf_bilapg ! lateral mixing (dyn_ldf_bilapg routine) 20 USE dynldf_bilap ! lateral mixing (dyn_ldf_bilap routine) 21 USE dynldf_iso ! lateral mixing (dyn_ldf_iso routine) 22 USE dynldf_lap ! lateral mixing (dyn_ldf_lap routine) 18 USE ldfdyn ! lateral diffusion: eddy viscosity coef. 19 USE ldfslp ! lateral diffusion: slopes of mixing orientation 20 USE dynldf_lap_blp ! lateral mixing (dyn_ldf_lap & dyn_ldf_blp routines) 21 USE dynldf_iso ! lateral mixing (dyn_ldf_iso routine ) 23 22 USE trd_oce ! trends: ocean variables 24 USE trddyn ! trend manager: dynamics (trd_dyn 23 USE trddyn ! trend manager: dynamics (trd_dyn routine) 25 24 ! 26 25 USE prtctl ! Print control … … 28 27 USE lib_mpp ! distribued memory computing library 29 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 30 USE wrk_nemo 31 USE timing 29 USE wrk_nemo ! Memory Allocation 30 USE timing ! Timing 32 31 33 32 IMPLICIT NONE … … 37 36 PUBLIC dyn_ldf_init ! called by opa module 38 37 39 INTEGER :: nldf = -2 ! type of lateral diffusion used defined from ln_dynldf_... namlist logicals) 38 ! ! Flag to control the type of lateral viscous operator 39 INTEGER, PARAMETER, PUBLIC :: np_ERROR =-10 ! error in setting the operator 40 INTEGER, PARAMETER, PUBLIC :: np_no_ldf = 00 ! without operator (i.e. no lateral viscous trend) 41 ! !! laplacian ! bilaplacian ! 42 INTEGER, PARAMETER, PUBLIC :: np_lap = 10 , np_blp = 20 ! iso-level operator 43 INTEGER, PARAMETER, PUBLIC :: np_lap_i = 11 ! iso-neutral or geopotential operator 44 45 INTEGER :: nldf ! type of lateral diffusion used defined from ln_dynldf_... (namlist logicals) 40 46 41 47 !! * Substitutions … … 43 49 # include "vectopt_loop_substitute.h90" 44 50 !!---------------------------------------------------------------------- 45 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)51 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 46 52 !! $Id$ 47 53 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 62 68 IF( nn_timing == 1 ) CALL timing_start('dyn_ldf') 63 69 ! 64 IF( l_trddyn ) THEN ! temporary save of ta and satrends65 CALL wrk_alloc( jpi, jpj, jpk,ztrdu, ztrdv )70 IF( l_trddyn ) THEN ! temporary save of momentum trends 71 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 66 72 ztrdu(:,:,:) = ua(:,:,:) 67 73 ztrdv(:,:,:) = va(:,:,:) … … 70 76 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 71 77 ! 72 CASE ( 0 ) ; CALL dyn_ldf_lap ( kt ) ! iso-level laplacian 73 CASE ( 1 ) ; CALL dyn_ldf_iso ( kt ) ! rotated laplacian (except dk[ dk[.] ] part) 74 CASE ( 2 ) ; CALL dyn_ldf_bilap ( kt ) ! iso-level bilaplacian 75 !!gm CASE ( 3 ) ; CALL dyn_ldf_bilapg ( kt ) ! s-coord. horizontal bilaplacian 76 CASE ( 4 ) ! iso-level laplacian + bilaplacian 77 CALL dyn_ldf_lap ( kt ) 78 CALL dyn_ldf_bilap ( kt ) 79 CASE ( 5 ) ! rotated laplacian + bilaplacian (s-coord) 80 CALL dyn_ldf_iso ( kt ) 81 !!gm CALL dyn_ldf_bilapg ( kt ) 78 CASE ( np_lap ) ; CALL dyn_ldf_lap ( kt, ub, vb, ua, va, 1 ) ! iso-level laplacian 79 CASE ( np_lap_i ) ; CALL dyn_ldf_iso ( kt ) ! rotated laplacian 80 CASE ( np_blp ) ; CALL dyn_ldf_blp ( kt, ub, vb, ua, va ) ! iso-level bi-laplacian 82 81 ! 83 CASE ( -1 ) ! esopa: test all possibility with control print84 CALL dyn_ldf_lap ( kt )85 CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf0 - Ua: ', mask1=umask, &86 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )87 CALL dyn_ldf_iso ( kt )88 CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf1 - Ua: ', mask1=umask, &89 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )90 CALL dyn_ldf_bilap ( kt )91 CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf2 - Ua: ', mask1=umask, &92 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )93 !!gm CALL dyn_ldf_bilapg ( kt )94 CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf3 - Ua: ', mask1=umask, &95 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )96 !97 CASE ( -2 ) ! neither laplacian nor bilaplacian schemes used98 IF( kt == nit000 ) THEN99 IF(lwp) WRITE(numout,*)100 IF(lwp) WRITE(numout,*) 'dyn_ldf : no lateral diffusion on momentum setup'101 IF(lwp) WRITE(numout,*) '~~~~~~~ '102 ENDIF103 82 END SELECT 104 83 … … 107 86 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 108 87 CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 109 CALL wrk_dealloc( jpi, jpj, jpk,ztrdu, ztrdv )88 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 110 89 ENDIF 111 90 ! ! print sum trends (used for debugging) … … 126 105 INTEGER :: ioptio, ierr ! temporary integers 127 106 !!---------------------------------------------------------------------- 128 107 ! 129 108 ! ! Namelist nam_dynldf: already read in ldfdyn module 130 109 ! 131 110 IF(lwp) THEN ! Namelist print 132 111 WRITE(numout,*) … … 134 113 WRITE(numout,*) '~~~~~~~~~~~' 135 114 WRITE(numout,*) ' Namelist nam_dynldf : set lateral mixing parameters (type, direction, coefficients)' 136 WRITE(numout,*) ' laplacian operator ln_dynldf_lap 137 WRITE(numout,*) ' bilaplacian operator ln_dynldf_b ilap = ', ln_dynldf_bilap138 WRITE(numout,*) ' iso-level ln_dynldf_lev el = ', ln_dynldf_level139 WRITE(numout,*) ' horizontal (geopotential) ln_dynldf_hor 140 WRITE(numout,*) ' iso-neutral ln_dynldf_iso 115 WRITE(numout,*) ' laplacian operator ln_dynldf_lap = ', ln_dynldf_lap 116 WRITE(numout,*) ' bilaplacian operator ln_dynldf_blp = ', ln_dynldf_blp 117 WRITE(numout,*) ' iso-level ln_dynldf_lev = ', ln_dynldf_lev 118 WRITE(numout,*) ' horizontal (geopotential) ln_dynldf_hor = ', ln_dynldf_hor 119 WRITE(numout,*) ' iso-neutral ln_dynldf_iso = ', ln_dynldf_iso 141 120 ENDIF 142 143 ! ! control the consistency121 ! ! use of lateral operator or not 122 nldf = np_ERROR 144 123 ioptio = 0 145 IF( ln_dynldf_lap ) ioptio = ioptio + 1 146 IF( ln_dynldf_bilap ) ioptio = ioptio + 1 147 IF( ioptio < 1 ) CALL ctl_warn( ' neither laplacian nor bilaplacian operator set for dynamics' ) 148 ioptio = 0 149 IF( ln_dynldf_level ) ioptio = ioptio + 1 150 IF( ln_dynldf_hor ) ioptio = ioptio + 1 151 IF( ln_dynldf_iso ) ioptio = ioptio + 1 152 IF( ioptio > 1 ) CALL ctl_stop( ' use only ONE direction (level/hor/iso)' ) 153 154 IF( ln_dynldf_iso .AND. ln_traldf_hor ) CALL ctl_stop & 155 & ( 'Not sensible to use geopotential diffusion for tracers with isoneutral diffusion for dynamics' ) 156 157 ! ! Set nldf, the type of lateral diffusion, from ln_dynldf_... logicals 158 ierr = 0 159 IF ( ln_dynldf_lap ) THEN ! laplacian operator 160 IF ( ln_zco ) THEN ! z-coordinate 161 IF ( ln_dynldf_level ) nldf = 0 ! iso-level (no rotation) 162 IF ( ln_dynldf_hor ) nldf = 0 ! horizontal (no rotation) 163 IF ( ln_dynldf_iso ) nldf = 1 ! isoneutral ( rotation) 124 IF( ln_dynldf_lap ) ioptio = ioptio + 1 125 IF( ln_dynldf_blp ) ioptio = ioptio + 1 126 IF( ioptio > 1 ) CALL ctl_stop( 'dyn_ldf_init: use ONE or NONE of the 2 lap/bilap operator type on momentum' ) 127 IF( ioptio == 0 ) nldf = np_no_ldf ! No lateral mixing operator 128 ! 129 IF( nldf /= np_no_ldf ) THEN ! direction ==>> type of operator 130 ioptio = 0 131 IF( ln_dynldf_lev ) ioptio = ioptio + 1 132 IF( ln_dynldf_hor ) ioptio = ioptio + 1 133 IF( ln_dynldf_iso ) ioptio = ioptio + 1 134 IF( ioptio > 1 ) CALL ctl_stop( ' use only ONE direction (level/hor/iso)' ) 135 IF( ioptio == 0 ) CALL ctl_stop( ' use at least ONE direction (level/hor/iso)' ) 136 ! 137 ! ! Set nldf, the type of lateral diffusion, from ln_dynldf_... logicals 138 ierr = 0 139 IF ( ln_dynldf_lap ) THEN ! laplacian operator 140 IF ( ln_zco ) THEN ! z-coordinate 141 IF ( ln_dynldf_lev ) nldf = np_lap ! iso-level = horizontal (no rotation) 142 IF ( ln_dynldf_hor ) nldf = np_lap ! iso-level = horizontal (no rotation) 143 IF ( ln_dynldf_iso ) nldf = np_lap_i ! iso-neutral ( rotation) 144 ENDIF 145 IF ( ln_zps ) THEN ! z-coordinate with partial step 146 IF ( ln_dynldf_lev ) nldf = np_lap ! iso-level (no rotation) 147 IF ( ln_dynldf_hor ) nldf = np_lap ! iso-level (no rotation) 148 IF ( ln_dynldf_iso ) nldf = np_lap_i ! iso-neutral ( rotation) 149 ENDIF 150 IF ( ln_sco ) THEN ! s-coordinate 151 IF ( ln_dynldf_lev ) nldf = np_lap ! iso-level = horizontal (no rotation) 152 IF ( ln_dynldf_hor ) nldf = np_lap_i ! horizontal ( rotation) 153 IF ( ln_dynldf_iso ) nldf = np_lap_i ! iso-neutral ( rotation) 154 ENDIF 164 155 ENDIF 165 IF ( ln_zps ) THEN ! z-coordinate 166 IF ( ln_dynldf_level ) ierr = 1 ! iso-level not allowed 167 IF ( ln_dynldf_hor ) nldf = 0 ! horizontal (no rotation) 168 IF ( ln_dynldf_iso ) nldf = 1 ! isoneutral ( rotation) 156 ! 157 IF( ln_dynldf_blp ) THEN ! bilaplacian operator 158 IF ( ln_zco ) THEN ! z-coordinate 159 IF ( ln_dynldf_lev ) nldf = np_blp ! iso-level = horizontal (no rotation) 160 IF ( ln_dynldf_hor ) nldf = np_blp ! iso-level = horizontal (no rotation) 161 IF ( ln_dynldf_iso ) ierr = 2 ! iso-neutral ( rotation) 162 ENDIF 163 IF ( ln_zps ) THEN ! z-coordinate with partial step 164 IF ( ln_dynldf_lev ) nldf = np_blp ! iso-level (no rotation) 165 IF ( ln_dynldf_hor ) nldf = np_blp ! iso-level (no rotation) 166 IF ( ln_dynldf_iso ) ierr = 2 ! iso-neutral ( rotation) 167 ENDIF 168 IF ( ln_sco ) THEN ! s-coordinate 169 IF ( ln_dynldf_lev ) nldf = np_blp ! iso-level (no rotation) 170 IF ( ln_dynldf_hor ) ierr = 2 ! horizontal ( rotation) 171 IF ( ln_dynldf_iso ) ierr = 2 ! iso-neutral ( rotation) 172 ENDIF 169 173 ENDIF 170 IF ( ln_sco ) THEN ! s-coordinate171 IF ( ln_dynldf_level ) nldf = 0 ! iso-level (no rotation)172 IF ( ln_dynldf_hor ) nldf = 1 ! horizontal ( rotation)173 IF ( ln_dynldf_iso ) nldf = 1 ! isoneutral ( rotation)174 ENDIF174 ! 175 IF( ierr == 2 ) CALL ctl_stop( 'rotated bi-laplacian operator does not exist' ) 176 ! 177 IF( nldf == np_lap_i ) l_ldfslp = .TRUE. ! rotation require the computation of the slopes 178 ! 175 179 ENDIF 176 177 IF( ln_dynldf_bilap ) THEN ! bilaplacian operator178 IF ( ln_zco ) THEN ! z-coordinate179 IF ( ln_dynldf_level ) nldf = 2 ! iso-level (no rotation)180 IF ( ln_dynldf_hor ) nldf = 2 ! horizontal (no rotation)181 IF ( ln_dynldf_iso ) ierr = 2 ! isoneutral ( rotation)182 ENDIF183 IF ( ln_zps ) THEN ! z-coordinate184 IF ( ln_dynldf_level ) ierr = 1 ! iso-level not allowed185 IF ( ln_dynldf_hor ) nldf = 2 ! horizontal (no rotation)186 IF ( ln_dynldf_iso ) ierr = 2 ! isoneutral ( rotation)187 ENDIF188 IF ( ln_sco ) THEN ! s-coordinate189 IF ( ln_dynldf_level ) nldf = 2 ! iso-level (no rotation)190 IF ( ln_dynldf_hor ) nldf = 3 ! horizontal ( rotation)191 IF ( ln_dynldf_iso ) ierr = 2 ! isoneutral ( rotation)192 ENDIF193 ENDIF194 195 IF( ln_dynldf_lap .AND. ln_dynldf_bilap ) THEN ! mixed laplacian and bilaplacian operators196 IF ( ln_zco ) THEN ! z-coordinate197 IF ( ln_dynldf_level ) nldf = 4 ! iso-level (no rotation)198 IF ( ln_dynldf_hor ) nldf = 4 ! horizontal (no rotation)199 IF ( ln_dynldf_iso ) ierr = 2 ! isoneutral ( rotation)200 ENDIF201 IF ( ln_zps ) THEN ! z-coordinate202 IF ( ln_dynldf_level ) ierr = 1 ! iso-level not allowed203 IF ( ln_dynldf_hor ) nldf = 4 ! horizontal (no rotation)204 IF ( ln_dynldf_iso ) ierr = 2 ! isoneutral ( rotation)205 ENDIF206 IF ( ln_sco ) THEN ! s-coordinate207 IF ( ln_dynldf_level ) nldf = 4 ! iso-level (no rotation)208 IF ( ln_dynldf_hor ) nldf = 5 ! horizontal ( rotation)209 IF ( ln_dynldf_iso ) ierr = 2 ! isoneutral ( rotation)210 ENDIF211 ENDIF212 213 IF( lk_esopa ) nldf = -1 ! esopa test214 215 IF( ierr == 1 ) CALL ctl_stop( 'iso-level in z-coordinate - partial step, not allowed' )216 IF( ierr == 2 ) CALL ctl_stop( 'isoneutral bilaplacian operator does not exist' )217 IF( nldf == 1 .OR. nldf == 3 ) l_ldfslp = .TRUE. ! the rotation needs slope computation218 180 219 181 IF(lwp) THEN 220 182 WRITE(numout,*) 221 IF( nldf == -2 ) WRITE(numout,*) ' neither laplacian nor bilaplacian schemes used' 222 IF( nldf == -1 ) WRITE(numout,*) ' ESOPA test All scheme used' 223 IF( nldf == 0 ) WRITE(numout,*) ' laplacian operator' 224 IF( nldf == 1 ) WRITE(numout,*) ' rotated laplacian operator' 225 IF( nldf == 2 ) WRITE(numout,*) ' bilaplacian operator' 226 IF( nldf == 3 ) WRITE(numout,*) ' rotated bilaplacian' 227 IF( nldf == 4 ) WRITE(numout,*) ' laplacian and bilaplacian operators' 228 IF( nldf == 5 ) WRITE(numout,*) ' rotated laplacian and bilaplacian operators' 183 IF( nldf == np_no_ldf ) WRITE(numout,*) ' NO lateral viscosity' 184 IF( nldf == np_lap ) WRITE(numout,*) ' iso-level laplacian operator' 185 IF( nldf == np_lap_i ) WRITE(numout,*) ' rotated laplacian operator with iso-level background' 186 IF( nldf == np_blp ) WRITE(numout,*) ' iso-level bi-laplacian operator' 229 187 ENDIF 230 188 ! -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
r5758 r5777 2 2 !!====================================================================== 3 3 !! *** MODULE dynldf_iso *** 4 !! Ocean dynamics: lateral viscosity trend4 !! Ocean dynamics: lateral viscosity trend (rotated laplacian operator) 5 5 !!====================================================================== 6 6 !! History : OPA ! 97-07 (G. Madec) Original code … … 8 8 !! - ! 2004-08 (C. Talandier) New trends organization 9 9 !! 2.0 ! 2005-11 (G. Madec) s-coordinate: horizontal diffusion 10 !! 3.7 ! 2014-01 (F. Lemarie, G. Madec) restructuration/simplification of ahm specification, 11 !! ! add velocity dependent coefficient and optional read in file 10 12 !!---------------------------------------------------------------------- 11 13 … … 17 19 USE oce ! ocean dynamics and tracers 18 20 USE dom_oce ! ocean space and time domain 19 USE ldfdyn _oce ! ocean dynamics lateral physics20 USE ldftra ! lateral physics: eddy diffusivity & EIV coefficients21 USE ldfdyn ! lateral diffusion: eddy viscosity coef. 22 USE ldftra ! lateral physics: eddy diffusivity 21 23 USE zdf_oce ! ocean vertical physics 22 24 USE ldfslp ! iso-neutral slopes 23 25 ! 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link)25 26 USE in_out_manager ! I/O manager 26 27 USE lib_mpp ! MPP library 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 27 29 USE prtctl ! Print control 28 30 USE wrk_nemo ! Memory Allocation … … 40 42 !! * Substitutions 41 43 # include "domzgr_substitute.h90" 42 # include "ldfdyn_substitute.h90"43 44 # include "vectopt_loop_substitute.h90" 44 45 !!---------------------------------------------------------------------- … … 81 82 !! horizontal fluxes associated with the rotated lateral mixing: 82 83 !! u-component: 83 !! ziut = ( ahmt + ahmb0) e2t * e3t / e1t di[ ub ]84 !! - ahmte2t * mi-1(uslp) dk[ mi(mk(ub)) ]85 !! zjuf = ( ahmf + ahmb0) e1f * e3f / e2f dj[ ub ]86 !! - ahmfe1f * mi(vslp) dk[ mj(mk(ub)) ]84 !! ziut = ( ahmt + rn_ahm_b ) e2t * e3t / e1t di[ ub ] 85 !! - ahmt e2t * mi-1(uslp) dk[ mi(mk(ub)) ] 86 !! zjuf = ( ahmf + rn_ahm_b ) e1f * e3f / e2f dj[ ub ] 87 !! - ahmf e1f * mi(vslp) dk[ mj(mk(ub)) ] 87 88 !! v-component: 88 !! zivf = ( ahmf + ahmb0) e2t * e3t / e1t di[ vb ]89 !! - ahmfe2t * mj(uslp) dk[ mi(mk(vb)) ]90 !! zjvt = ( ahmt + ahmb0) e1f * e3f / e2f dj[ ub ]91 !! - ahmte1f * mj-1(vslp) dk[ mj(mk(vb)) ]89 !! zivf = ( ahmf + rn_ahm_b ) e2t * e3t / e1t di[ vb ] 90 !! - ahmf e2t * mj(uslp) dk[ mi(mk(vb)) ] 91 !! zjvt = ( ahmt + rn_ahm_b ) e1f * e3f / e2f dj[ ub ] 92 !! - ahmt e1f * mj-1(vslp) dk[ mj(mk(vb)) ] 92 93 !! take the horizontal divergence of the fluxes: 93 94 !! diffu = 1/(e1u*e2u*e3u) { di [ ziut ] + dj-1[ zjuf ] } … … 108 109 INTEGER :: ji, jj, jk ! dummy loop indices 109 110 REAL(wp) :: zabe1, zabe2, zcof1, zcof2 ! local scalars 110 REAL(wp) :: zmskt, zmskf , zbu, zbv, zuah, zvah! - -111 REAL(wp) :: zmskt, zmskf ! - - 111 112 REAL(wp) :: zcoef0, zcoef3, zcoef4, zmkt, zmkf ! - - 112 113 REAL(wp) :: zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj ! - - … … 127 128 ENDIF 128 129 129 ! s-coordinate: Iso-level diffusion on tracer, but geopotential level diffusion on momentum 130 !!gm bug is dyn_ldf_iso called before tra_ldf_iso .... <<<<<===== TO BE CHECKED 131 ! s-coordinate: Iso-level diffusion on momentum but not on tracer 130 132 IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 131 133 ! … … 133 135 DO jj = 2, jpjm1 134 136 DO ji = 2, jpim1 135 uslp (ji,jj,jk) = - 1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk)) * umask(ji,jj,jk)136 vslp (ji,jj,jk) = - 1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk)) * vmask(ji,jj,jk)137 wslpi(ji,jj,jk) = - 1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk)) * tmask(ji,jj,jk) * 0.5138 wslpj(ji,jj,jk) = - 1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk)) * tmask(ji,jj,jk) * 0.5137 uslp (ji,jj,jk) = - ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 138 vslp (ji,jj,jk) = - ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 139 wslpi(ji,jj,jk) = - ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5 140 wslpj(ji,jj,jk) = - ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5 139 141 END DO 140 142 END DO … … 181 183 DO jj = 2, jpjm1 182 184 DO ji = fs_2, jpi ! vector opt. 183 zabe1 = ( fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) /e1t(ji,jj)184 185 zmskt = 1. /MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1)&186 & + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ), 1.)185 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) * r1_e1t(ji,jj) 186 187 zmskt = 1._wp / MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1) & 188 & + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ) , 1._wp ) 187 189 188 190 zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 189 191 192 ziut(ji,jj) = ( zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) ) & 193 & + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj) & 194 & +zdk1u(ji,jj) + zdku (ji-1,jj) ) ) * tmask(ji,jj,jk) 195 END DO 196 END DO 197 ELSE ! other coordinate system (zco or sco) : e3t 198 DO jj = 2, jpjm1 199 DO ji = fs_2, jpi ! vector opt. 200 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * fse3t(ji,jj,jk) * r1_e1t(ji,jj) 201 202 zmskt = 1._wp / MAX( umask(ji-1,jj,jk ) + umask(ji,jj,jk+1) & 203 & + umask(ji-1,jj,jk+1) + umask(ji,jj,jk ) , 1._wp ) 204 205 zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 206 190 207 ziut(ji,jj) = ( zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) ) & 191 208 & + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj) & … … 193 210 END DO 194 211 END DO 195 ELSE ! other coordinate system (zco or sco) : e3t196 DO jj = 2, jpjm1197 DO ji = fs_2, jpi ! vector opt.198 zabe1 = (fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)199 200 zmskt = 1./MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1) &201 & + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ), 1. )202 203 zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )204 205 ziut(ji,jj) = ( zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) ) &206 & + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj) &207 & +zdk1u(ji,jj) + zdku (ji-1,jj) ) ) * tmask(ji,jj,jk)208 END DO209 END DO210 212 ENDIF 211 213 … … 213 215 DO jj = 1, jpjm1 214 216 DO ji = 1, fs_jpim1 ! vector opt. 215 zabe2 = ( fsahmf(ji,jj,jk) + ahmb0 ) * e1f(ji,jj) * fse3f(ji,jj,jk) /e2f(ji,jj)216 217 zmskf = 1. /MAX( umask(ji,jj+1,jk )+umask(ji,jj,jk+1)&218 & + umask(ji,jj+1,jk+1)+umask(ji,jj,jk ), 1.)217 zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * fse3f(ji,jj,jk) * r1_e2f(ji,jj) 218 219 zmskf = 1._wp / MAX( umask(ji,jj+1,jk )+umask(ji,jj,jk+1) & 220 & + umask(ji,jj+1,jk+1)+umask(ji,jj,jk ) , 1._wp ) 219 221 220 222 zcof2 = - rn_aht_0 * e1f(ji,jj) * zmskf * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) … … 234 236 DO jj = 2, jpjm1 235 237 DO ji = 1, fs_jpim1 ! vector opt. 236 zabe1 = ( fsahmf(ji,jj,jk) + ahmb0 ) * e2f(ji,jj) * fse3f(ji,jj,jk) /e1f(ji,jj)237 238 zmskf = 1. /MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1)&239 & + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk ), 1.)238 zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * fse3f(ji,jj,jk) * r1_e1f(ji,jj) 239 240 zmskf = 1._wp / MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1) & 241 & + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk ) , 1._wp ) 240 242 241 243 zcof1 = - rn_aht_0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 242 244 243 zivf(ji,jj) = ( zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) ) &244 & + zcof1 * ( zdkv (ji,jj) + zdk1v(ji+1,jj)&245 & + zdk1v(ji,jj) + zdkv (ji+1,jj) ) ) * fmask(ji,jj,jk)245 zivf(ji,jj) = ( zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) ) & 246 & + zcof1 * ( zdkv (ji,jj) + zdk1v(ji+1,jj) & 247 & + zdk1v(ji,jj) + zdkv (ji+1,jj) ) ) * fmask(ji,jj,jk) 246 248 END DO 247 249 END DO … … 251 253 DO jj = 2, jpj 252 254 DO ji = 1, fs_jpim1 ! vector opt. 253 zabe2 = (fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) / e2t(ji,jj) 255 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) * r1_e2t(ji,jj) 256 257 zmskt = 1._wp / MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & 258 & + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ) , 1._wp ) 259 260 zcof2 = - rn_aht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 261 262 zjvt(ji,jj) = ( zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) ) & 263 & + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj) & 264 & +zdk1v(ji,jj-1) + zdkv (ji,jj) ) ) * tmask(ji,jj,jk) 265 END DO 266 END DO 267 ELSE ! other coordinate system (zco or sco) : e3t 268 DO jj = 2, jpj 269 DO ji = 1, fs_jpim1 ! vector opt. 270 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * fse3t(ji,jj,jk) * r1_e2t(ji,jj) 254 271 255 272 zmskt = 1./MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & … … 263 280 END DO 264 281 END DO 265 ELSE ! other coordinate system (zco or sco) : e3t266 DO jj = 2, jpj267 DO ji = 1, fs_jpim1 ! vector opt.268 zabe2 = (fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj)269 270 zmskt = 1./MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) &271 & + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1. )272 273 zcof2 = - rn_aht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )274 275 zjvt(ji,jj) = ( zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) ) &276 & + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj) &277 & +zdk1v(ji,jj-1) + zdkv (ji,jj) ) ) * tmask(ji,jj,jk)278 END DO279 END DO280 282 ENDIF 281 283 … … 283 285 ! Second derivative (divergence) and add to the general trend 284 286 ! ----------------------------------------------------------- 285 286 287 DO jj = 2, jpjm1 287 DO ji = 2, jpim1 !! Question vectop possible??? !!bug 288 ! volume elements 289 zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 290 zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 291 ! horizontal component of isopycnal momentum diffusive trends 292 zuah =( ziut (ji+1,jj) - ziut (ji,jj ) + & 293 & zjuf (ji ,jj) - zjuf (ji,jj-1) ) / zbu 294 zvah =( zivf (ji,jj ) - zivf (ji-1,jj) + & 295 & zjvt (ji,jj+1) - zjvt (ji,jj ) ) / zbv 296 ! add the trends to the general trends 297 ua (ji,jj,jk) = ua (ji,jj,jk) + zuah 298 va (ji,jj,jk) = va (ji,jj,jk) + zvah 288 DO ji = 2, jpim1 !!gm Question vectop possible??? !!bug 289 ua(ji,jj,jk) = ua(ji,jj,jk) + ( ziut(ji+1,jj) - ziut(ji,jj ) & 290 & + zjuf(ji ,jj) - zjuf(ji,jj-1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 291 va(ji,jj,jk) = va(ji,jj,jk) + ( zivf(ji,jj ) - zivf(ji-1,jj) & 292 & + zjvt(ji,jj+1) - zjvt(ji,jj ) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 299 293 END DO 300 294 END DO … … 362 356 zmkt = 1./MAX( tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1) & 363 357 + tmask(ji,jj,jk )+tmask(ji+1,jj,jk ), 1. ) 364 zmkf = 1./MAX( fmask(ji,jj-1,jk-1) +fmask(ji,jj,jk-1) &365 + fmask(ji,jj-1,jk ) +fmask(ji,jj,jk ), 1. )358 zmkf = 1./MAX( fmask(ji,jj-1,jk-1) + fmask(ji,jj,jk-1) & 359 + fmask(ji,jj-1,jk ) + fmask(ji,jj,jk ), 1. ) 366 360 367 361 zcoef3 = - e2u(ji,jj) * zmkt * zuwslpi … … 409 403 DO jk = 1, jpkm1 410 404 DO ji = 2, jpim1 411 ! volume elements 412 zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk) 413 zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk) 414 ! part of the k-component of isopycnal momentum diffusive trends 415 zuav = ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / zbu 416 zvav = ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / zbv 417 ! add the trends to the general trends 418 ua(ji,jj,jk) = ua(ji,jj,jk) + zuav 419 va(ji,jj,jk) = va(ji,jj,jk) + zvav 405 ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 406 va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 420 407 END DO 421 408 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90
r5775 r5777 1 MODULE dynldf_lap 1 MODULE dynldf_lap_blp 2 2 !!====================================================================== 3 !! *** MODULE dynldf_lap ***4 !! Ocean dynamics: lateral viscosity trend 3 !! *** MODULE dynldf_lap_blp *** 4 !! Ocean dynamics: lateral viscosity trend (laplacian and bilaplacian) 5 5 !!====================================================================== 6 6 !! History : OPA ! 1990-09 (G. Madec) Original code … … 9 9 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 10 10 !! - ! 2004-08 (C. Talandier) New trends organization 11 !! 3.7 ! 2014-01 (F. Lemarie, G. Madec) restructuration/simplification of ahm specification, 12 !! ! add velocity dependent coefficient and optional read in file 11 13 !!---------------------------------------------------------------------- 12 14 13 15 !!---------------------------------------------------------------------- 14 !! dyn_ldf_lap : update the momentum trend with the lateral diffusion15 !! using an iso-level harmonicoperator16 !! dyn_ldf_lap : update the momentum trend with the lateral viscosity using an iso-level laplacian operator 17 !! dyn_ldf_blp : update the momentum trend with the lateral viscosity using an iso-level bilaplacian operator 16 18 !!---------------------------------------------------------------------- 17 USE oce ! ocean dynamics and tracers 18 USE dom_oce ! ocean space and time domain 19 USE ldfdyn_oce ! ocean dynamics: lateral physics 20 USE zdf_oce ! ocean vertical physics 19 USE oce ! ocean dynamics and tracers 20 USE dom_oce ! ocean space and time domain 21 USE ldfdyn ! lateral diffusion: eddy viscosity coef. 22 USE ldfslp ! iso-neutral slopes 23 USE zdf_oce ! ocean vertical physics 21 24 ! 22 USE in_out_manager ! I/O manager 23 USE timing ! Timing 25 USE in_out_manager ! I/O manager 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 27 USE wrk_nemo ! Memory Allocation 28 USE timing ! Timing 24 29 25 30 IMPLICIT NONE 26 31 PRIVATE 27 32 28 PUBLIC dyn_ldf_lap ! called by step.F90 33 PUBLIC dyn_ldf_lap ! called by dynldf.F90 34 PUBLIC dyn_ldf_blp ! called by dynldf.F90 29 35 30 36 !! * Substitutions 31 37 # include "domzgr_substitute.h90" 32 # include "ldfdyn_substitute.h90"33 38 # include "vectopt_loop_substitute.h90" 34 39 !!---------------------------------------------------------------------- 35 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)40 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 36 41 !! $Id$ 37 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 39 44 CONTAINS 40 45 41 SUBROUTINE dyn_ldf_lap( kt )46 SUBROUTINE dyn_ldf_lap( kt, pub, pvb, pua, pva, kpass ) 42 47 !!---------------------------------------------------------------------- 43 48 !! *** ROUTINE dyn_ldf_lap *** 44 49 !! 45 !! ** Purpose : Compute the before horizontal tracer (t & s)diffusive46 !! trend and add it to the general trend of tracerequation.50 !! ** Purpose : Compute the before horizontal momentum diffusive 51 !! trend and add it to the general trend of momentum equation. 47 52 !! 48 !! ** Method : The before horizontal momentum diffusion trend is an 49 !! harmonic operator (laplacian type) which separates the divergent 50 !! and rotational parts of the flow. 51 !! Its horizontal components are computed as follow: 52 !! difu = 1/e1u di[ahmt hdivb] - 1/(e2u*e3u) dj-1[e3f ahmf rotb] 53 !! difv = 1/e2v dj[ahmt hdivb] + 1/(e1v*e3v) di-1[e3f ahmf rotb] 54 !! in the rotational part of the diffusion. 55 !! Add this before trend to the general trend (ua,va): 56 !! (ua,va) = (ua,va) + (diffu,diffv) 53 !! ** Method : The Laplacian operator apply on horizontal velocity is 54 !! writen as : grad_h( ahmt div_h(U )) - curl_h( ahmf curl_z(U) ) 57 55 !! 58 !! ** Action : - Update (ua,va) with the iso-level harmonic mixing trend56 !! ** Action : - pua, pva increased by the harmonic operator applied on pub, pvb. 59 57 !!---------------------------------------------------------------------- 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 58 INTEGER , INTENT(in ) :: kt ! ocean time-step index 59 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 60 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pub, pvb ! before velocity [m/s] 61 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pua, pva ! velocity trend [m/s2] 61 62 ! 62 INTEGER :: ji, jj, jk ! dummy loop indices 63 REAL(wp) :: zua, zva, ze2u, ze1v ! local scalars 63 INTEGER :: ji, jj, jk ! dummy loop indices 64 REAL(wp) :: zsign ! local scalars 65 REAL(wp) :: zua, zva ! local scalars 66 REAL(wp), POINTER, DIMENSION(:,:) :: zcur, zdiv 64 67 !!---------------------------------------------------------------------- 65 68 ! 66 IF( nn_timing == 1 ) CALL timing_start('dyn_ldf_lap') 69 IF( kt == nit000 .AND. lwp ) THEN 70 WRITE(numout,*) 71 WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator, pass=', kpass 72 WRITE(numout,*) '~~~~~~~ ' 73 ENDIF 67 74 ! 68 IF( kt == nit000 ) THEN 69 IF(lwp) WRITE(numout,*) 70 IF(lwp) WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator' 71 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 75 IF( nn_timing == 1 ) CALL timing_start('dyn_ldf_lap') 76 ! 77 CALL wrk_alloc( jpi, jpj, zcur, zdiv ) 78 ! 79 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign 80 ELSE ; zsign = -1._wp ! (eddy viscosity coef. >0) 72 81 ENDIF 82 ! 73 83 ! ! =============== 74 84 DO jk = 1, jpkm1 ! Horizontal slab 75 85 ! ! =============== 76 DO jj = 2, jpjm1 86 DO jj = 2, jpj 87 DO ji = fs_2, jpi ! vector opt. 88 ! ! ahm * e3 * curl (computed from 1 to jpim1/jpjm1) 89 zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * fse3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1) & 90 & * ( e2v(ji ,jj-1) * pvb(ji ,jj-1,jk) - e2v(ji-1,jj-1) * pvb(ji-1,jj-1,jk) & 91 & - e1u(ji-1,jj ) * pub(ji-1,jj ,jk) + e1u(ji-1,jj-1) * pub(ji-1,jj-1,jk) ) * fmask(ji-1,jj-1,jk) 92 ! ! ahm * div (computed from 2 to jpi/jpj) 93 zdiv(ji,jj) = ahmt(ji,jj,jk) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) * tmask(ji,jj,jk) & 94 & * ( e2u(ji,jj)*fse3u(ji,jj,jk) * pub(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * pub(ji-1,jj,jk) & 95 & + e1v(ji,jj)*fse3v(ji,jj,jk) * pvb(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * pvb(ji,jj-1,jk) ) 96 END DO 97 END DO 98 ! 99 DO jj = 2, jpjm1 ! - curl( curl) + grad( div ) 77 100 DO ji = fs_2, fs_jpim1 ! vector opt. 78 ze2u = rotb (ji,jj,jk) * fsahmf(ji,jj,jk) * fse3f(ji,jj,jk) 79 ze1v = hdivb(ji,jj,jk) * fsahmt(ji,jj,jk) 80 ! horizontal diffusive trends 81 zua = - ( ze2u - rotb (ji,jj-1,jk)*fsahmf(ji,jj-1,jk)*fse3f(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) & 82 + ( hdivb(ji+1,jj,jk)*fsahmt(ji+1,jj,jk) - ze1v ) * r1_e1u(ji,jj) 83 84 zva = + ( ze2u - rotb (ji-1,jj,jk)*fsahmf(ji-1,jj,jk)*fse3f(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) & 85 + ( hdivb(ji,jj+1,jk)*fsahmt(ji,jj+1,jk) - ze1v ) * r1_e2v(ji,jj) 86 87 ! add it to the general momentum trends 88 ua(ji,jj,jk) = ua(ji,jj,jk) + zua 89 va(ji,jj,jk) = va(ji,jj,jk) + zva 101 pua(ji,jj,jk) = pua(ji,jj,jk) + zsign * ( & 102 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) & 103 & + ( zdiv(ji+1,jj) - zdiv(ji,jj ) ) * r1_e1u(ji,jj) ) 104 ! 105 pva(ji,jj,jk) = pva(ji,jj,jk) + zsign * ( & 106 & ( zcur(ji,jj ) - zcur(ji-1,jj) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) & 107 & + ( zdiv(ji,jj+1) - zdiv(ji ,jj) ) * r1_e2v(ji,jj) ) 90 108 END DO 91 109 END DO … … 93 111 END DO ! End of slab 94 112 ! ! =============== 113 CALL wrk_dealloc( jpi, jpj, zcur, zdiv ) 114 ! 95 115 IF( nn_timing == 1 ) CALL timing_stop('dyn_ldf_lap') 96 116 ! 97 117 END SUBROUTINE dyn_ldf_lap 98 118 119 120 SUBROUTINE dyn_ldf_blp( kt, pub, pvb, pua, pva ) 121 !!---------------------------------------------------------------------- 122 !! *** ROUTINE dyn_ldf_blp *** 123 !! 124 !! ** Purpose : Compute the before lateral momentum viscous trend 125 !! and add it to the general trend of momentum equation. 126 !! 127 !! ** Method : The lateral viscous trends is provided by a bilaplacian 128 !! operator applied to before field (forward in time). 129 !! It is computed by two successive calls to dyn_ldf_lap routine 130 !! 131 !! ** Action : pta updated with the before rotated bilaplacian diffusion 132 !!---------------------------------------------------------------------- 133 INTEGER , INTENT(in ) :: kt ! ocean time-step index 134 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pub, pvb ! before velocity fields 135 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pua, pva ! momentum trend 136 ! 137 REAL(wp), POINTER, DIMENSION(:,:,:) :: zulap, zvlap ! laplacian at u- and v-point 138 !!---------------------------------------------------------------------- 139 ! 140 IF( nn_timing == 1 ) CALL timing_start('dyn_ldf_blp') 141 ! 142 CALL wrk_alloc( jpi, jpj, jpk, zulap, zvlap ) 143 ! 144 IF( kt == nit000 ) THEN 145 IF(lwp) WRITE(numout,*) 146 IF(lwp) WRITE(numout,*) 'dyn_ldf_blp : bilaplacian operator momentum ' 147 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 148 ENDIF 149 ! 150 zulap(:,:,:) = 0._wp 151 zvlap(:,:,:) = 0._wp 152 ! 153 CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 ) ! rotated laplacian applied to ptb (output in zlap) 154 ! 155 CALL lbc_lnk( zulap(:,:,:) , 'U', -1. ) ! Lateral boundary conditions 156 CALL lbc_lnk( zvlap(:,:,:) , 'V', -1. ) 157 ! 158 CALL dyn_ldf_lap( kt, zulap, zvlap, pua, pva, 2 ) ! rotated laplacian applied to zlap (output in pta) 159 ! 160 CALL wrk_dealloc( jpi, jpj, jpk, zulap, zvlap ) 161 ! 162 IF( nn_timing == 1 ) CALL timing_stop('dyn_ldf_blp') 163 ! 164 END SUBROUTINE dyn_ldf_blp 165 99 166 !!====================================================================== 100 END MODULE dynldf_lap 167 END MODULE dynldf_lap_blp -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r5770 r5777 77 77 !! Note that as all external forcing a time averaging over a two rdt 78 78 !! period is used to prevent the divergence of odd and even time step. 79 !!80 !! N.B. : When key_esopa is used all the scheme are tested, regardless81 !! of the physical meaning of the results.82 79 !!---------------------------------------------------------------------- 83 80 ! … … 121 118 DO ji = fs_2, fs_jpim1 ! vector opt. 122 119 spgu(ji,jj) = spgu(ji,jj) + zg_2 * ( ssh_ib (ji+1,jj) - ssh_ib (ji,jj) & 123 & + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj) ) /e1u(ji,jj)120 & + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj) 124 121 spgv(ji,jj) = spgv(ji,jj) + zg_2 * ( ssh_ib (ji,jj+1) - ssh_ib (ji,jj) & 125 & + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj) ) /e2v(ji,jj)122 & + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj) ) * r1_e2v(ji,jj) 126 123 END DO 127 124 END DO … … 135 132 DO jj = 2, jpjm1 ! add tide potential forcing 136 133 DO ji = fs_2, fs_jpim1 ! vector opt. 137 spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) /e1u(ji,jj)138 spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) /e2v(ji,jj)134 spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 135 spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 139 136 END DO 140 137 END DO … … 149 146 DO jj = 2, jpjm1 150 147 DO ji = fs_2, fs_jpim1 ! vector opt. 151 spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) /e1u(ji,jj)152 spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) /e2v(ji,jj)148 spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 149 spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 153 150 END DO 154 151 END DO … … 176 173 CASE ( 2 ) ; CALL dyn_spg_flt( kt, kindic ) ! filtered 177 174 ! 178 CASE ( -1 ) ! esopa: test all possibility with control print179 CALL dyn_spg_exp( kt )180 CALL prt_ctl( tab3d_1=ua, clinfo1=' spg0 - Ua: ', mask1=umask, &181 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )182 CALL dyn_spg_ts ( kt )183 CALL prt_ctl( tab3d_1=ua, clinfo1=' spg1 - Ua: ', mask1=umask, &184 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )185 CALL dyn_spg_flt( kt, kindic )186 CALL prt_ctl( tab3d_1=ua, clinfo1=' spg2 - Ua: ', mask1=umask, &187 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )188 175 END SELECT 189 176 ! … … 248 235 IF(lk_dynspg_flt) ioptio = ioptio + 1 249 236 ! 250 IF( ( ioptio > 1 .AND. .NOT. lk_esopa ).OR. ( ioptio == 0 .AND. .NOT. lk_c1d ) ) &237 IF( ioptio > 1 .OR. ( ioptio == 0 .AND. .NOT. lk_c1d ) ) & 251 238 & CALL ctl_stop( ' Choose only one surface pressure gradient scheme with a key cpp' ) 252 239 IF( ( lk_dynspg_ts .OR. lk_dynspg_exp ) .AND. ln_isfcav ) & 253 240 & CALL ctl_stop( ' dynspg_ts and dynspg_exp not tested with ice shelf cavity ' ) 254 241 ! 255 IF( lk_esopa ) nspg = -1256 242 IF( lk_dynspg_exp) nspg = 0 257 243 IF( lk_dynspg_ts ) nspg = 1 258 244 IF( lk_dynspg_flt) nspg = 2 259 245 ! 260 IF( lk_esopa ) nspg = -1261 !262 246 IF(lwp) THEN 263 247 WRITE(numout,*) 264 IF( nspg == -1 ) WRITE(numout,*) ' ESOPA test All scheme used'265 248 IF( nspg == 0 ) WRITE(numout,*) ' explicit free surface' 266 249 IF( nspg == 1 ) WRITE(numout,*) ' free surface with time splitting scheme' … … 268 251 ENDIF 269 252 270 #if defined key_dynspg_flt || defined key_esopa253 #if defined key_dynspg_flt 271 254 CALL solver_init( nit000 ) ! Elliptic solver initialisation 272 255 #endif -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
r4990 r5777 7 7 !! 3.2 ! 2009-06 (G. Madec, M. Leclair, R. Benshila) introduce sshwzv module 8 8 !!---------------------------------------------------------------------- 9 #if defined key_dynspg_exp || defined key_esopa9 #if defined key_dynspg_exp 10 10 !!---------------------------------------------------------------------- 11 11 !! 'key_dynspg_exp' explicit free surface -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r5770 r5777 16 16 !! - ! 2014-12 (G. Madec) remove cross-land advection (cla) 17 17 !!---------------------------------------------------------------------- 18 #if defined key_dynspg_flt || defined key_esopa18 #if defined key_dynspg_flt 19 19 !!---------------------------------------------------------------------- 20 20 !! 'key_dynspg_flt' filtered free surface -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90
r4486 r5777 17 17 18 18 ! !!! Surface pressure gradient logicals 19 #if defined key_dynspg_exp || defined key_esopa19 #if defined key_dynspg_exp 20 20 LOGICAL, PUBLIC, PARAMETER :: lk_dynspg_exp = .TRUE. !: Explicit free surface flag 21 21 #else 22 22 LOGICAL, PUBLIC, PARAMETER :: lk_dynspg_exp = .FALSE. !: Explicit free surface flag 23 23 #endif 24 #if defined key_dynspg_ts || defined key_esopa24 #if defined key_dynspg_ts 25 25 LOGICAL, PUBLIC, PARAMETER :: lk_dynspg_ts = .TRUE. !: Free surface with time splitting flag 26 26 #else 27 27 LOGICAL, PUBLIC, PARAMETER :: lk_dynspg_ts = .FALSE. !: Free surface with time splitting flag 28 28 #endif 29 #if defined key_dynspg_flt || defined key_esopa29 #if defined key_dynspg_flt 30 30 LOGICAL, PUBLIC, PARAMETER :: lk_dynspg_flt = .TRUE. !: Filtered free surface cst volume flag 31 31 #else 32 32 LOGICAL, PUBLIC, PARAMETER :: lk_dynspg_flt = .FALSE. !: Filtered free surface cst volume flag 33 33 #endif 34 35 34 ! !!! Time splitting scheme (key_dynspg_ts) 36 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_e, ssha_e ! sea surface heigth (now, after) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r5737 r5777 12 12 !! 3.6 ! 2013-11 (A. Coward) Update for z-tilde compatibility 13 13 !!--------------------------------------------------------------------- 14 #if defined key_dynspg_ts || defined key_esopa14 #if defined key_dynspg_ts 15 15 !!---------------------------------------------------------------------- 16 16 !! 'key_dynspg_ts' split explicit free surface … … 98 98 ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) ) 99 99 100 IF( ln_dynvor_een .or. ln_dynvor_een_old) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , &101 &ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) )100 IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 101 & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) ) 102 102 103 103 dyn_spg_ts_alloc = MAXVAL(ierr(:)) … … 220 220 ! 221 221 IF ( kt == nit000 .OR. lk_vvl ) THEN 222 IF ( ln_dynvor_een_old ) THEN 223 DO jj = 1, jpjm1 224 DO ji = 1, jpim1 225 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 226 & ht(ji ,jj ) + ht(ji+1,jj ) ) / 4._wp 227 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zwz(ji,jj) 228 END DO 229 END DO 222 IF ( ln_dynvor_een ) THEN !== EEN scheme ==! 223 SELECT CASE( nn_een_e3f ) !* ff/e3 at F-point 224 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 225 DO jj = 1, jpjm1 226 DO ji = 1, jpim1 227 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 228 & ht(ji ,jj ) + ht(ji+1,jj ) ) / 4._wp 229 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj) 230 END DO 231 END DO 232 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 233 DO jj = 1, jpjm1 234 DO ji = 1, jpim1 235 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 236 & ht(ji ,jj ) + ht(ji+1,jj ) ) & 237 & / ( MAX( 1._wp, tmask(ji ,jj+1, 1) + tmask(ji+1,jj+1, 1) + & 238 & tmask(ji ,jj , 1) + tmask(ji+1,jj , 1) ) ) 239 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj) 240 END DO 241 END DO 242 END SELECT 230 243 CALL lbc_lnk( zwz, 'F', 1._wp ) 231 zwz(:,:) = ff(:,:) * zwz(:,:) 232 244 ! 233 245 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 234 246 DO jj = 2, jpj 235 DO ji = fs_2, jpi ! vector opt.247 DO ji = 2, jpi 236 248 ftne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) 237 249 ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj ) + zwz(ji ,jj ) … … 240 252 END DO 241 253 END DO 242 ELSE IF ( ln_dynvor_een ) THEN 243 DO jj = 1, jpjm1 244 DO ji = 1, jpim1 245 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 246 & ht(ji ,jj ) + ht(ji+1,jj ) ) & 247 & / ( MAX( 1.0_wp, tmask(ji ,jj+1, 1) + tmask(ji+1,jj+1, 1) + & 248 & tmask(ji ,jj , 1) + tmask(ji+1,jj , 1) ) ) 249 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zwz(ji,jj) 250 END DO 251 END DO 252 CALL lbc_lnk( zwz, 'F', 1._wp ) 253 zwz(:,:) = ff(:,:) * zwz(:,:) 254 255 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 256 DO jj = 2, jpj 257 DO ji = fs_2, jpi ! vector opt. 258 ftne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) 259 ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj ) + zwz(ji ,jj ) 260 ftse(ji,jj) = zwz(ji ,jj ) + zwz(ji ,jj-1) + zwz(ji-1,jj-1) 261 ftsw(ji,jj) = zwz(ji ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj ) 262 END DO 263 END DO 264 ELSE 254 ! 255 ELSE !== all other schemes (ENE, ENS, MIX) 265 256 zwz(:,:) = 0._wp 266 zhf(:,:) = 0. 257 zhf(:,:) = 0._wp 267 258 IF ( .not. ln_sco ) THEN 259 260 !!gm agree the JC comment : this should be done in a much clear way 261 268 262 ! JC: It not clear yet what should be the depth at f-points over land in z-coordinate case 269 263 ! Set it to zero for the time being … … 277 271 278 272 DO jj = 1, jpjm1 279 zhf(:,jj) = zhf(:,jj) *(1._wp- umask(:,jj,1) * umask(:,jj+1,1))273 zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 280 274 END DO 281 275 … … 298 292 ! If forward start at previous time step, and centered integration, 299 293 ! then update averaging weights: 300 IF ( (.NOT.ln_bt_fw).AND.((neuler==0).AND.(kt==nit000+1))) THEN294 IF (.NOT.ln_bt_fw .AND.( neuler==0 .AND. kt==nit000+1 ) ) THEN 301 295 ll_fw_start=.FALSE. 302 296 CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2) … … 361 355 END DO 362 356 ! 363 ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old) THEN ! enstrophy and energy conserving scheme357 ELSEIF ( ln_dynvor_een ) THEN ! enstrophy and energy conserving scheme 364 358 DO jj = 2, jpjm1 365 359 DO ji = fs_2, fs_jpim1 ! vector opt. … … 710 704 END DO 711 705 ! 712 ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old) THEN !== energy and enstrophy conserving scheme ==!706 ELSEIF ( ln_dynvor_een ) THEN !== energy and enstrophy conserving scheme ==! 713 707 DO jj = 2, jpjm1 714 708 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r5737 r5777 16 16 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 17 17 !! 3.7 ! 2014-04 (G. Madec) trend simplification: suppress jpdyn_trd_dat vorticity 18 !! - ! 2014-06 (G. Madec) suppression of velocity curl from in-core memory 18 19 !!---------------------------------------------------------------------- 19 20 … … 22 23 !! vor_ens : enstrophy conserving scheme (ln_dynvor_ens=T) 23 24 !! vor_ene : energy conserving scheme (ln_dynvor_ene=T) 24 !! vor_mix : mixed enstrophy/energy conserving (ln_dynvor_mix=T)25 25 !! vor_een : energy and enstrophy conserving (ln_dynvor_een=T) 26 26 !! dyn_vor_init : set and control of the different vorticity option … … 32 32 USE trd_oce ! trends: ocean variables 33 33 USE trddyn ! trend manager: dynamics 34 ! 34 35 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 35 36 USE prtctl ! Print control … … 44 45 45 46 PUBLIC dyn_vor ! routine called by step.F90 46 PUBLIC dyn_vor_init ! routine called by opa.F9047 PUBLIC dyn_vor_init ! routine called by nemogcm.F90 47 48 48 49 ! !!* Namelist namdyn_vor: vorticity term 49 LOGICAL, PUBLIC :: ln_dynvor_ene !: energy conserving scheme 50 LOGICAL, PUBLIC :: ln_dynvor_ens !: enstrophy conserving scheme 51 LOGICAL, PUBLIC :: ln_dynvor_mix !: mixed scheme 52 LOGICAL, PUBLIC :: ln_dynvor_een !: energy and enstrophy conserving scheme 53 LOGICAL, PUBLIC :: ln_dynvor_een_old !: energy and enstrophy conserving scheme (original formulation) 54 55 INTEGER :: nvor = 0 ! type of vorticity trend used 56 INTEGER :: ncor = 1 ! coriolis 57 INTEGER :: nrvm = 2 ! =2 relative vorticity ; =3 metric term 58 INTEGER :: ntot = 4 ! =4 total vorticity (relative + planetary) ; =5 coriolis + metric term 59 50 LOGICAL, PUBLIC :: ln_dynvor_ene !: energy conserving scheme (ENE) 51 LOGICAL, PUBLIC :: ln_dynvor_ens !: enstrophy conserving scheme (ENS) 52 LOGICAL, PUBLIC :: ln_dynvor_mix !: mixed scheme (MIX) 53 LOGICAL, PUBLIC :: ln_dynvor_een !: energy and enstrophy conserving scheme (EEN) 54 INTEGER, PUBLIC :: nn_een_e3f !: e3f=masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 55 LOGICAL, PUBLIC :: ln_dynvor_msk !: vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes) 56 57 INTEGER :: nvor_scheme ! choice of the type of advection scheme 58 ! ! associated indices: 59 INTEGER, PUBLIC, PARAMETER :: np_ENE = 1 ! ENE scheme 60 INTEGER, PUBLIC, PARAMETER :: np_ENS = 2 ! ENS scheme 61 INTEGER, PUBLIC, PARAMETER :: np_MIX = 3 ! MIX scheme 62 INTEGER, PUBLIC, PARAMETER :: np_EEN = 4 ! EEN scheme 63 64 INTEGER :: ncor, nrvm, ntot ! choice of calculated vorticity 65 ! ! associated indices: 66 INTEGER, PARAMETER :: np_COR = 1 ! Coriolis (planetary) 67 INTEGER, PARAMETER :: np_RVO = 2 ! relative vorticity 68 INTEGER, PARAMETER :: np_MET = 3 ! metric term 69 INTEGER, PARAMETER :: np_CRV = 4 ! relative + planetary (total vorticity) 70 INTEGER, PARAMETER :: np_CME = 5 ! Coriolis + metric term 71 72 REAL(wp) :: r1_4 = 0.250_wp ! =1/4 73 REAL(wp) :: r1_8 = 0.125_wp ! =1/8 74 REAL(wp) :: r1_12 = 1._wp / 12._wp ! 1/12 75 60 76 !! * Substitutions 61 77 # include "domzgr_substitute.h90" 62 78 # include "vectopt_loop_substitute.h90" 63 79 !!---------------------------------------------------------------------- 64 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)80 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 65 81 !! $Id$ 66 82 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 87 103 IF( l_trddyn ) CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 88 104 ! 89 ! ! vorticity term 90 SELECT CASE ( nvor ) ! compute the vorticity trend and add it to the general trend 91 ! 92 CASE ( -1 ) ! esopa: test all possibility with control print 93 CALL vor_ene( kt, ntot, ua, va ) 94 CALL prt_ctl( tab3d_1=ua, clinfo1=' vor0 - Ua: ', mask1=umask, & 95 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 96 CALL vor_ens( kt, ntot, ua, va ) 97 CALL prt_ctl( tab3d_1=ua, clinfo1=' vor1 - Ua: ', mask1=umask, & 98 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 99 CALL vor_mix( kt ) 100 CALL prt_ctl( tab3d_1=ua, clinfo1=' vor2 - Ua: ', mask1=umask, & 101 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 102 CALL vor_een( kt, ntot, ua, va ) 103 CALL prt_ctl( tab3d_1=ua, clinfo1=' vor3 - Ua: ', mask1=umask, & 104 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 105 ! 106 CASE ( 0 ) ! energy conserving scheme 107 IF( l_trddyn ) THEN 108 ztrdu(:,:,:) = ua(:,:,:) 109 ztrdv(:,:,:) = va(:,:,:) 110 CALL vor_ene( kt, nrvm, ua, va ) ! relative vorticity or metric trend 105 SELECT CASE ( nvor_scheme ) !== vorticity trend added to the general trend ==! 106 ! 107 CASE ( np_ENE ) !* energy conserving scheme 108 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 109 ztrdu(:,:,:) = ua(:,:,:) 110 ztrdv(:,:,:) = va(:,:,:) 111 CALL vor_ene( kt, nrvm, ua, va ) ! relative vorticity or metric trend 111 112 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 112 113 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) … … 114 115 ztrdu(:,:,:) = ua(:,:,:) 115 116 ztrdv(:,:,:) = va(:,:,:) 116 CALL vor_ene( kt, ncor, ua, va ) ! planetary vorticity trend117 CALL vor_ene( kt, ncor, ua, va ) ! planetary vorticity trend 117 118 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 118 119 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 119 120 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 120 121 ELSE 121 CALL vor_ene( kt, ntot, ua, va ) ! total vorticity 122 ENDIF 123 ! 124 CASE ( 1 ) !enstrophy conserving scheme125 IF( l_trddyn ) THEN126 ztrdu(:,:,:) = ua(:,:,:) 127 ztrdv(:,:,:) = va(:,:,:) 128 CALL vor_ens( kt, nrvm, ua, va ) ! relative vorticity or metric trend122 CALL vor_ene( kt, ntot, ua, va ) ! total vorticity trend 123 ENDIF 124 ! 125 CASE ( np_ENS ) !* enstrophy conserving scheme 126 IF( l_trddyn ) THEN ! trend diagnostics: splitthe trend in two 127 ztrdu(:,:,:) = ua(:,:,:) 128 ztrdv(:,:,:) = va(:,:,:) 129 CALL vor_ens( kt, nrvm, ua, va ) ! relative vorticity or metric trend 129 130 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 130 131 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) … … 132 133 ztrdu(:,:,:) = ua(:,:,:) 133 134 ztrdv(:,:,:) = va(:,:,:) 134 CALL vor_ens( kt, ncor, ua, va ) ! planetary vorticity trend135 CALL vor_ens( kt, ncor, ua, va ) ! planetary vorticity trend 135 136 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 136 137 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 137 138 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 138 139 ELSE 139 CALL vor_ens( kt, ntot, ua, va ) ! total vorticity 140 ENDIF 141 ! 142 CASE ( 2 ) !mixed ene-ens scheme143 IF( l_trddyn ) THEN144 ztrdu(:,:,:) = ua(:,:,:) 145 ztrdv(:,:,:) = va(:,:,:) 146 CALL vor_ens( kt, nrvm, ua, va ) ! relative vorticity or metric trend (ens)140 CALL vor_ens( kt, ntot, ua, va ) ! total vorticity trend 141 ENDIF 142 ! 143 CASE ( np_MIX ) !* mixed ene-ens scheme 144 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 145 ztrdu(:,:,:) = ua(:,:,:) 146 ztrdv(:,:,:) = va(:,:,:) 147 CALL vor_ens( kt, nrvm, ua, va ) ! relative vorticity or metric trend (ens) 147 148 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 148 149 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) … … 150 151 ztrdu(:,:,:) = ua(:,:,:) 151 152 ztrdv(:,:,:) = va(:,:,:) 152 CALL vor_ene( kt, ncor, ua, va ) ! planetary vorticity trend (ene)153 CALL vor_ene( kt, ncor, ua, va ) ! planetary vorticity trend (ene) 153 154 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 154 155 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 155 156 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 156 157 ELSE 157 CALL vor_mix( kt ) ! total vorticity (mix=ens-ene) 158 ENDIF 159 ! 160 CASE ( 3 ) ! energy and enstrophy conserving scheme 161 IF( l_trddyn ) THEN 162 ztrdu(:,:,:) = ua(:,:,:) 163 ztrdv(:,:,:) = va(:,:,:) 164 CALL vor_een( kt, nrvm, ua, va ) ! relative vorticity or metric trend 158 CALL vor_ens( kt, nrvm, ua, va ) ! relative vorticity or metric trend (ens) 159 CALL vor_ene( kt, ncor, ua, va ) ! planetary vorticity trend (ene) 160 ENDIF 161 ! 162 CASE ( np_EEN ) !* energy and enstrophy conserving scheme 163 IF( l_trddyn ) THEN ! trend diagnostics: split the trend in two 164 ztrdu(:,:,:) = ua(:,:,:) 165 ztrdv(:,:,:) = va(:,:,:) 166 CALL vor_een( kt, nrvm, ua, va ) ! relative vorticity or metric trend 165 167 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 166 168 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) … … 168 170 ztrdu(:,:,:) = ua(:,:,:) 169 171 ztrdv(:,:,:) = va(:,:,:) 170 CALL vor_een( kt, ncor, ua, va ) ! planetary vorticity trend172 CALL vor_een( kt, ncor, ua, va ) ! planetary vorticity trend 171 173 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 172 174 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 173 175 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 174 176 ELSE 175 CALL vor_een( kt, ntot, ua, va ) ! total vorticity 177 CALL vor_een( kt, ntot, ua, va ) ! total vorticity trend 176 178 ENDIF 177 179 ! … … 197 199 !! 198 200 !! ** Method : Trend evaluated using now fields (centered in time) 199 !! and the Sadourny (1975) flux form formulation : conserves the 200 !! horizontal kinetic energy. 201 !! The trend of the vorticity term is given by: 202 !! * s-coordinate (ln_sco=T), the e3. are inside the derivatives: 203 !! voru = 1/e1u mj-1[ (rotn+f)/e3f mi(e1v*e3v vn) ] 204 !! vorv = 1/e2v mi-1[ (rotn+f)/e3f mj(e2u*e3u un) ] 205 !! * z-coordinate (default key), e3t=e3u=e3v, the trend becomes: 206 !! voru = 1/e1u mj-1[ (rotn+f) mi(e1v vn) ] 207 !! vorv = 1/e2v mi-1[ (rotn+f) mj(e2u un) ] 208 !! Add this trend to the general momentum trend (ua,va): 209 !! (ua,va) = (ua,va) + ( voru , vorv ) 201 !! and the Sadourny (1975) flux form formulation : conserves the 202 !! horizontal kinetic energy. 203 !! The general trend of momentum is increased due to the vorticity 204 !! term which is given by: 205 !! voru = 1/e1u mj-1[ (rvor+f)/e3f mi(e1v*e3v vn) ] 206 !! vorv = 1/e2v mi-1[ (rvor+f)/e3f mj(e2u*e3u un) ] 207 !! where rvor is the relative vorticity 210 208 !! 211 209 !! ** Action : - Update (ua,va) with the now vorticity term trend … … 219 217 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pva ! total v-trend 220 218 ! 221 INTEGER :: ji, jj, jk ! dummy loop indices222 REAL(wp) :: zx1, zy1, z fact2, zx2, zy2 ! local scalars223 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz219 INTEGER :: ji, jj, jk ! dummy loop indices 220 REAL(wp) :: zx1, zy1, zx2, zy2 ! local scalars 221 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz ! 2D workspace 224 222 !!---------------------------------------------------------------------- 225 223 ! … … 233 231 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 234 232 ENDIF 235 236 zfact2 = 0.5 * 0.5 ! Local constant initialization 237 233 ! 238 234 ! ! =============== 239 235 DO jk = 1, jpkm1 ! Horizontal slab 240 236 ! ! =============== 241 237 ! 242 ! Potential vorticity and horizontal fluxes 243 ! ----------------------------------------- 244 SELECT CASE( kvor ) ! vorticity considered 245 CASE ( 1 ) ; zwz(:,:) = ff(:,:) ! planetary vorticity (Coriolis) 246 CASE ( 2 ) ; zwz(:,:) = rotn(:,:,jk) ! relative vorticity 247 CASE ( 3 ) ! metric term 238 SELECT CASE( kvor ) !== vorticity considered ==! 239 CASE ( np_COR ) !* Coriolis (planetary vorticity) 240 zwz(:,:) = ff(:,:) 241 CASE ( np_RVO ) !* relative vorticity 242 DO jj = 1, jpjm1 243 DO ji = 1, fs_jpim1 ! vector opt. 244 zwz(ji,jj) = ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 245 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) * r1_e1e2f(ji,jj) 246 END DO 247 END DO 248 CASE ( np_MET ) !* metric term 248 249 DO jj = 1, jpjm1 249 250 DO ji = 1, fs_jpim1 ! vector opt. … … 253 254 END DO 254 255 END DO 255 CASE ( 4 ) ; zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) ! total (relative + planetary vorticity) 256 CASE ( 5 ) ! total (coriolis + metric) 257 DO jj = 1, jpjm1 258 DO ji = 1, fs_jpim1 ! vector opt. 259 zwz(ji,jj) = ( ff (ji,jj) & 260 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 261 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 262 & * 0.5 * r1_e1e2f(ji,jj) & 263 & ) 264 END DO 265 END DO 256 CASE ( np_CRV ) !* Coriolis + relative vorticity 257 DO jj = 1, jpjm1 258 DO ji = 1, fs_jpim1 ! vector opt. 259 zwz(ji,jj) = ff(ji,jj) + ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 260 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 261 & * r1_e1e2f(ji,jj) 262 END DO 263 END DO 264 CASE ( np_CME ) !* Coriolis + metric 265 DO jj = 1, jpjm1 266 DO ji = 1, fs_jpim1 ! vector opt. 267 zwz(ji,jj) = ff(ji,jj) & 268 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 269 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 270 & * 0.5 * r1_e1e2f(ji,jj) 271 END DO 272 END DO 273 CASE DEFAULT ! error 274 CALL ctl_stop('STOP','dyn_vor: wrong value for kvor' ) 266 275 END SELECT 276 ! 277 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 278 DO jj = 1, jpjm1 279 DO ji = 1, fs_jpim1 ! vector opt. 280 zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 281 END DO 282 END DO 283 ENDIF 267 284 268 285 IF( ln_sco ) THEN … … 274 291 zwy(:,:) = e1v(:,:) * vn(:,:,jk) 275 292 ENDIF 276 277 ! Compute and add the vorticity term trend 278 ! ---------------------------------------- 293 ! !== compute and add the vorticity term trend =! 279 294 DO jj = 2, jpjm1 280 295 DO ji = fs_2, fs_jpim1 ! vector opt. … … 283 298 zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1) 284 299 zx2 = zwx(ji ,jj) + zwx(ji ,jj+1) 285 pua(ji,jj,jk) = pua(ji,jj,jk) + zfact2* r1_e1u(ji,jj) * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 )286 pva(ji,jj,jk) = pva(ji,jj,jk) - zfact2* r1_e2v(ji,jj) * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 )300 pua(ji,jj,jk) = pua(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 301 pva(ji,jj,jk) = pva(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) 287 302 END DO 288 303 END DO … … 297 312 298 313 299 SUBROUTINE vor_mix( kt )300 !!----------------------------------------------------------------------301 !! *** ROUTINE vor_mix ***302 !!303 !! ** Purpose : Compute the now total vorticity trend and add it to304 !! the general trend of the momentum equation.305 !!306 !! ** Method : Trend evaluated using now fields (centered in time)307 !! Mixte formulation : conserves the potential enstrophy of a hori-308 !! zontally non-divergent flow for (rotzu x uh), the relative vor-309 !! ticity term and the horizontal kinetic energy for (f x uh), the310 !! coriolis term. the now trend of the vorticity term is given by:311 !! * s-coordinate (ln_sco=T), the e3. are inside the derivatives:312 !! voru = 1/e1u mj-1(rotn/e3f) mj-1[ mi(e1v*e3v vn) ]313 !! +1/e1u mj-1[ f/e3f mi(e1v*e3v vn) ]314 !! vorv = 1/e2v mi-1(rotn/e3f) mi-1[ mj(e2u*e3u un) ]315 !! +1/e2v mi-1[ f/e3f mj(e2u*e3u un) ]316 !! * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:317 !! voru = 1/e1u mj-1(rotn) mj-1[ mi(e1v vn) ]318 !! +1/e1u mj-1[ f mi(e1v vn) ]319 !! vorv = 1/e2v mi-1(rotn) mi-1[ mj(e2u un) ]320 !! +1/e2v mi-1[ f mj(e2u un) ]321 !! Add this now trend to the general momentum trend (ua,va):322 !! (ua,va) = (ua,va) + ( voru , vorv )323 !!324 !! ** Action : - Update (ua,va) arrays with the now vorticity term trend325 !!326 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.327 !!----------------------------------------------------------------------328 !329 INTEGER, INTENT(in) :: kt ! ocean timestep index330 !331 INTEGER :: ji, jj, jk ! dummy loop indices332 REAL(wp) :: zfact1, zua, zcua, zx1, zy1 ! local scalars333 REAL(wp) :: zfact2, zva, zcva, zx2, zy2 ! - -334 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww335 !!----------------------------------------------------------------------336 !337 IF( nn_timing == 1 ) CALL timing_start('vor_mix')338 !339 CALL wrk_alloc( jpi, jpj, zwx, zwy, zwz, zww )340 !341 IF( kt == nit000 ) THEN342 IF(lwp) WRITE(numout,*)343 IF(lwp) WRITE(numout,*) 'dyn:vor_mix : vorticity term: mixed energy/enstrophy conserving scheme'344 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'345 ENDIF346 347 zfact1 = 0.5 * 0.25 ! Local constant initialization348 zfact2 = 0.5 * 0.5349 350 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, zww )351 ! ! ===============352 DO jk = 1, jpkm1 ! Horizontal slab353 ! ! ===============354 !355 ! Relative and planetary potential vorticity and horizontal fluxes356 ! ----------------------------------------------------------------357 IF( ln_sco ) THEN358 IF( ln_dynadv_vec ) THEN359 zww(:,:) = rotn(:,:,jk) / fse3f(:,:,jk)360 ELSE361 DO jj = 1, jpjm1362 DO ji = 1, fs_jpim1 ! vector opt.363 zww(ji,jj) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) &364 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) &365 & * 0.5 / ( e1e2f (ji,jj) * fse3f(ji,jj,jk) )366 END DO367 END DO368 ENDIF369 zwz(:,:) = ff (:,:) / fse3f(:,:,jk)370 zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)371 zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)372 ELSE373 IF( ln_dynadv_vec ) THEN374 zww(:,:) = rotn(:,:,jk)375 ELSE376 DO jj = 1, jpjm1377 DO ji = 1, fs_jpim1 ! vector opt.378 zww(ji,jj) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) &379 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) &380 & * 0.5 * r1_e1e2f(ji,jj)381 END DO382 END DO383 ENDIF384 zwz(:,:) = ff (:,:)385 zwx(:,:) = e2u(:,:) * un(:,:,jk)386 zwy(:,:) = e1v(:,:) * vn(:,:,jk)387 ENDIF388 389 ! Compute and add the vorticity term trend390 ! ----------------------------------------391 DO jj = 2, jpjm1392 DO ji = fs_2, fs_jpim1 ! vector opt.393 zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj)394 zy2 = ( zwy(ji,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj)395 zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj)396 zx2 = ( zwx(ji ,jj) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj)397 ! enstrophy conserving formulation for relative vorticity term398 zua = zfact1 * ( zww(ji ,jj-1) + zww(ji,jj) ) * ( zy1 + zy2 )399 zva =-zfact1 * ( zww(ji-1,jj ) + zww(ji,jj) ) * ( zx1 + zx2 )400 ! energy conserving formulation for planetary vorticity term401 zcua = zfact2 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 )402 zcva =-zfact2 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 )403 ! mixed vorticity trend added to the momentum trends404 ua(ji,jj,jk) = ua(ji,jj,jk) + zcua + zua405 va(ji,jj,jk) = va(ji,jj,jk) + zcva + zva406 END DO407 END DO408 ! ! ===============409 END DO ! End of slab410 ! ! ===============411 CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz, zww )412 !413 IF( nn_timing == 1 ) CALL timing_stop('vor_mix')414 !415 END SUBROUTINE vor_mix416 417 418 314 SUBROUTINE vor_ens( kt, kvor, pua, pva ) 419 315 !!---------------------------------------------------------------------- … … 427 323 !! potential enstrophy of a horizontally non-divergent flow. the 428 324 !! trend of the vorticity term is given by: 429 !! * s-coordinate (ln_sco=T), the e3. are inside the derivative: 430 !! voru = 1/e1u mj-1[ (rotn+f)/e3f ] mj-1[ mi(e1v*e3v vn) ] 431 !! vorv = 1/e2v mi-1[ (rotn+f)/e3f ] mi-1[ mj(e2u*e3u un) ] 432 !! * z-coordinate (default key), e3t=e3u=e3v, the trend becomes: 433 !! voru = 1/e1u mj-1[ rotn+f ] mj-1[ mi(e1v vn) ] 434 !! vorv = 1/e2v mi-1[ rotn+f ] mi-1[ mj(e2u un) ] 325 !! voru = 1/e1u mj-1[ (rvor+f)/e3f ] mj-1[ mi(e1v*e3v vn) ] 326 !! vorv = 1/e2v mi-1[ (rvor+f)/e3f ] mi-1[ mj(e2u*e3u un) ] 435 327 !! Add this trend to the general momentum trend (ua,va): 436 328 !! (ua,va) = (ua,va) + ( voru , vorv ) … … 440 332 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 441 333 !!---------------------------------------------------------------------- 442 !443 334 INTEGER , INTENT(in ) :: kt ! ocean time-step index 444 335 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; … … 447 338 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pva ! total v-trend 448 339 ! 449 INTEGER :: ji, jj, jk 450 REAL(wp) :: z fact1, zuav, zvau ! temporaryscalars451 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww340 INTEGER :: ji, jj, jk ! dummy loop indices 341 REAL(wp) :: zuav, zvau ! local scalars 342 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww ! 2D workspace 452 343 !!---------------------------------------------------------------------- 453 344 ! … … 461 352 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 462 353 ENDIF 463 464 zfact1 = 0.5 * 0.25 ! Local constant initialization465 466 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz )467 354 ! ! =============== 468 355 DO jk = 1, jpkm1 ! Horizontal slab 469 356 ! ! =============== 470 357 ! 471 ! Potential vorticity and horizontal fluxes 472 ! ----------------------------------------- 473 SELECT CASE( kvor ) ! vorticity considered 474 CASE ( 1 ) ; zwz(:,:) = ff(:,:) ! planetary vorticity (Coriolis) 475 CASE ( 2 ) ; zwz(:,:) = rotn(:,:,jk) ! relative vorticity 476 CASE ( 3 ) ! metric term 358 SELECT CASE( kvor ) !== vorticity considered ==! 359 CASE ( np_COR ) !* Coriolis (planetary vorticity) 360 zwz(:,:) = ff(:,:) 361 CASE ( np_RVO ) !* relative vorticity 362 DO jj = 1, jpjm1 363 DO ji = 1, fs_jpim1 ! vector opt. 364 zwz(ji,jj) = ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 365 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) * r1_e1e2f(ji,jj) 366 END DO 367 END DO 368 CASE ( np_MET ) !* metric term 477 369 DO jj = 1, jpjm1 478 370 DO ji = 1, fs_jpim1 ! vector opt. … … 482 374 END DO 483 375 END DO 484 CASE ( 4 ) ; zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) ! total (relative + planetary vorticity) 485 CASE ( 5 ) ! total (coriolis + metric) 486 DO jj = 1, jpjm1 487 DO ji = 1, fs_jpim1 ! vector opt. 488 zwz(ji,jj) = ( ff (ji,jj) & 489 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 490 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 491 & * 0.5 * r1_e1e2f(ji,jj) & 492 & ) 493 END DO 494 END DO 376 CASE ( np_CRV ) !* Coriolis + relative vorticity 377 DO jj = 1, jpjm1 378 DO ji = 1, fs_jpim1 ! vector opt. 379 zwz(ji,jj) = ff(ji,jj) + ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 380 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 381 & * r1_e1e2f(ji,jj) 382 END DO 383 END DO 384 CASE ( np_CME ) !* Coriolis + metric 385 DO jj = 1, jpjm1 386 DO ji = 1, fs_jpim1 ! vector opt. 387 zwz(ji,jj) = ff(ji,jj) & 388 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 389 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 390 & * 0.5 * r1_e1e2f(ji,jj) 391 END DO 392 END DO 393 CASE DEFAULT ! error 394 CALL ctl_stop('STOP','dyn_vor: wrong value for kvor' ) 495 395 END SELECT 396 ! 397 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 398 DO jj = 1, jpjm1 399 DO ji = 1, fs_jpim1 ! vector opt. 400 zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 401 END DO 402 END DO 403 ENDIF 496 404 ! 497 405 IF( ln_sco ) THEN !== horizontal fluxes ==! … … 506 414 DO jj = 2, jpjm1 507 415 DO ji = fs_2, fs_jpim1 ! vector opt. 508 zuav = zfact1* r1_e1u(ji,jj) * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) &509 & 510 zvau =- zfact1* r1_e2v(ji,jj) * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) &511 & 416 zuav = r1_8 * r1_e1u(ji,jj) * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 417 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) 418 zvau =-r1_8 * r1_e2v(ji,jj) * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 419 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) 512 420 pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji ,jj-1) + zwz(ji,jj) ) 513 421 pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj ) + zwz(ji,jj) ) … … 542 450 !!---------------------------------------------------------------------- 543 451 INTEGER , INTENT(in ) :: kt ! ocean time-step index 544 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; 545 ! ! =nrvm (relative vorticity or metric) 452 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; =nrvm (relative or metric) 546 453 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pua ! total u-trend 547 454 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pva ! total v-trend 548 !! 549 INTEGER :: ji, jj, jk ! dummy loop indices 550 INTEGER :: ierr ! local integer 551 REAL(wp) :: zfac12, zua, zva ! local scalars 552 REAL(wp) :: zmsk, ze3 ! local scalars 553 ! ! 3D workspace 554 REAL(wp), POINTER , DIMENSION(:,: ) :: zwx, zwy, zwz 555 REAL(wp), POINTER , DIMENSION(:,: ) :: ztnw, ztne, ztsw, ztse 556 #if defined key_vvl 557 REAL(wp), POINTER , DIMENSION(:,:,:) :: ze3f ! 3D workspace (lk_vvl=T) 558 #else 559 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: ze3f ! lk_vvl=F, ze3f=1/e3f saved one for all 560 #endif 455 ! 456 INTEGER :: ji, jj, jk ! dummy loop indices 457 INTEGER :: ierr ! local integer 458 REAL(wp) :: zua, zva ! local scalars 459 REAL(wp) :: zmsk, ze3 ! local scalars 460 ! 461 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, z1_e3f 462 REAL(wp), POINTER, DIMENSION(:,:) :: ztnw, ztne, ztsw, ztse 561 463 !!---------------------------------------------------------------------- 562 464 ! 563 465 IF( nn_timing == 1 ) CALL timing_start('vor_een') 564 466 ! 565 CALL wrk_alloc( jpi, jpj, zwx , zwy , zwz ) 566 CALL wrk_alloc( jpi, jpj, ztnw, ztne, ztsw, ztse ) 567 #if defined key_vvl 568 CALL wrk_alloc( jpi, jpj, jpk, ze3f ) 569 #endif 467 CALL wrk_alloc( jpi,jpj, zwx , zwy , zwz , z1_e3f ) 468 CALL wrk_alloc( jpi,jpj, ztnw, ztne, ztsw, ztse ) 570 469 ! 571 470 IF( kt == nit000 ) THEN … … 573 472 IF(lwp) WRITE(numout,*) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme' 574 473 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 575 #if ! defined key_vvl576 IF( .NOT.ALLOCATED(ze3f) ) THEN577 ALLOCATE( ze3f(jpi,jpj,jpk) , STAT=ierr )578 IF( lk_mpp ) CALL mpp_sum ( ierr )579 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'dyn:vor_een : unable to allocate arrays' )580 ENDIF581 ze3f(:,:,:) = 0._wp582 #endif583 474 ENDIF 584 585 IF( kt == nit000 .OR. lk_vvl ) THEN ! reciprocal of e3 at F-point (masked averaging of e3t over ocean points) 586 587 IF( ln_dynvor_een_old ) THEN ! original formulation 588 DO jk = 1, jpk 589 DO jj = 1, jpjm1 590 DO ji = 1, jpim1 591 ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 592 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 593 IF( ze3 /= 0._wp ) ze3f(ji,jj,jk) = 4.0_wp / ze3 594 END DO 595 END DO 596 END DO 597 ELSE ! new formulation from NEMO 3.6 598 DO jk = 1, jpk 599 DO jj = 1, jpjm1 600 DO ji = 1, jpim1 601 ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 602 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 603 zmsk = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 604 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) ) 605 IF( ze3 /= 0._wp ) ze3f(ji,jj,jk) = zmsk / ze3 606 END DO 607 END DO 608 END DO 609 ENDIF 610 611 CALL lbc_lnk( ze3f, 'F', 1. ) 612 ENDIF 613 614 zfac12 = 1._wp / 12._wp ! Local constant initialization 615 475 ! 616 476 ! ! =============== 617 477 DO jk = 1, jpkm1 ! Horizontal slab 618 478 ! ! =============== 619 620 ! Potential vorticity and horizontal fluxes 621 ! ----------------------------------------- 622 SELECT CASE( kvor ) ! vorticity considered 623 CASE ( 1 ) ! planetary vorticity (Coriolis) 624 zwz(:,:) = ff(:,:) * ze3f(:,:,jk) 625 CASE ( 2 ) ! relative vorticity 626 zwz(:,:) = rotn(:,:,jk) * ze3f(:,:,jk) 627 CASE ( 3 ) ! metric term 479 ! 480 SELECT CASE( nn_een_e3f ) ! == reciprocal of e3 at F-point 481 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 482 DO jj = 1, jpjm1 483 DO ji = 1, fs_jpim1 ! vector opt. 484 ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 485 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 486 IF( ze3 /= 0._wp ) THEN ; z1_e3f(ji,jj) = 4.0_wp / ze3 487 ELSE ; z1_e3f(ji,jj) = 0.0_wp 488 ENDIF 489 END DO 490 END DO 491 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 492 DO jj = 1, jpjm1 493 DO ji = 1, fs_jpim1 ! vector opt. 494 ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 495 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 496 zmsk = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 497 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) ) 498 IF( ze3 /= 0._wp ) THEN ; z1_e3f(ji,jj) = zmsk / ze3 499 ELSE ; z1_e3f(ji,jj) = 0.0_wp 500 ENDIF 501 END DO 502 END DO 503 END SELECT 504 ! 505 SELECT CASE( kvor ) !== vorticity considered ==! 506 CASE ( np_COR ) !* Coriolis (planetary vorticity) 507 DO jj = 1, jpjm1 508 DO ji = 1, fs_jpim1 ! vector opt. 509 zwz(ji,jj) = ff(ji,jj) * z1_e3f(ji,jj) 510 END DO 511 END DO 512 CASE ( np_RVO ) !* relative vorticity 513 DO jj = 1, jpjm1 514 DO ji = 1, fs_jpim1 ! vector opt. 515 zwz(ji,jj) = ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 516 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 517 & * r1_e1e2f(ji,jj) * z1_e3f(ji,jj) 518 END DO 519 END DO 520 CASE ( np_MET ) !* metric term 628 521 DO jj = 1, jpjm1 629 522 DO ji = 1, fs_jpim1 ! vector opt. 630 523 zwz(ji,jj) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 631 524 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 632 & * 0.5 * r1_e1e2f(ji,jj) * ze3f(ji,jj,jk) 633 END DO 634 END DO 635 CALL lbc_lnk( zwz, 'F', 1. ) 636 CASE ( 4 ) ! total (relative + planetary vorticity) 637 zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) * ze3f(:,:,jk) 638 CASE ( 5 ) ! total (coriolis + metric) 639 DO jj = 1, jpjm1 640 DO ji = 1, fs_jpim1 ! vector opt. 641 zwz(ji,jj) = ( ff (ji,jj) & 642 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 643 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 644 & * 0.5 * r1_e1e2f(ji,jj) ) * ze3f(ji,jj,jk) 645 END DO 646 END DO 647 CALL lbc_lnk( zwz, 'F', 1. ) 525 & * 0.5 * r1_e1e2f(ji,jj) * z1_e3f(ji,jj) 526 END DO 527 END DO 528 CASE ( np_CRV ) !* Coriolis + relative vorticity 529 DO jj = 1, jpjm1 530 DO ji = 1, fs_jpim1 ! vector opt. 531 zwz(ji,jj) = ( ff(ji,jj) + ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 532 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 533 & * r1_e1e2f(ji,jj) ) * z1_e3f(ji,jj) 534 END DO 535 END DO 536 CASE ( np_CME ) !* Coriolis + metric 537 DO jj = 1, jpjm1 538 DO ji = 1, fs_jpim1 ! vector opt. 539 zwz(ji,jj) = ( ff(ji,jj) & 540 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 541 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 542 & * 0.5 * r1_e1e2f(ji,jj) ) * z1_e3f(ji,jj) 543 END DO 544 END DO 545 CASE DEFAULT ! error 546 CALL ctl_stop('STOP','dyn_vor: wrong value for kvor' ) 648 547 END SELECT 548 ! 549 CALL lbc_lnk( zwz, 'F', 1. ) 550 ! 551 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 552 DO jj = 1, jpjm1 553 DO ji = 1, fs_jpim1 ! vector opt. 554 zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 555 END DO 556 END DO 557 ENDIF 649 558 ! 650 559 ! !== horizontal fluxes ==! … … 671 580 DO jj = 2, jpjm1 672 581 DO ji = fs_2, fs_jpim1 ! vector opt. 673 zua = + zfac12 * r1_e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) &674 & + ztse(ji,jj ) * zwy(ji ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )675 zva = - zfac12 * r1_e2v(ji,jj) * ( ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji ,jj+1) &676 & + ztnw(ji,jj ) * zwx(ji-1,jj ) + ztne(ji,jj ) * zwx(ji ,jj ) )582 zua = + r1_12 * r1_e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) & 583 & + ztse(ji,jj ) * zwy(ji ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) 584 zva = - r1_12 * r1_e2v(ji,jj) * ( ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji ,jj+1) & 585 & + ztnw(ji,jj ) * zwx(ji-1,jj ) + ztne(ji,jj ) * zwx(ji ,jj ) ) 677 586 pua(ji,jj,jk) = pua(ji,jj,jk) + zua 678 587 pva(ji,jj,jk) = pva(ji,jj,jk) + zva … … 682 591 END DO ! End of slab 683 592 ! ! =============== 684 CALL wrk_dealloc( jpi, jpj, zwx , zwy , zwz ) 685 CALL wrk_dealloc( jpi, jpj, ztnw, ztne, ztsw, ztse ) 686 #if defined key_vvl 687 CALL wrk_dealloc( jpi, jpj, jpk, ze3f ) 688 #endif 593 ! 594 CALL wrk_dealloc( jpi,jpj, zwx , zwy , zwz , z1_e3f ) 595 CALL wrk_dealloc( jpi,jpj, ztnw, ztne, ztsw, ztse ) 689 596 ! 690 597 IF( nn_timing == 1 ) CALL timing_stop('vor_een') … … 704 611 INTEGER :: ios ! Local integer output status for namelist read 705 612 !! 706 NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een, ln_dynvor_een_old613 NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een, nn_een_e3f, ln_dynvor_msk 707 614 !!---------------------------------------------------------------------- 708 615 … … 721 628 WRITE(numout,*) '~~~~~~~~~~~~' 722 629 WRITE(numout,*) ' Namelist namdyn_vor : choice of the vorticity term scheme' 723 WRITE(numout,*) ' energy conserving scheme ln_dynvor_ene = ', ln_dynvor_ene 724 WRITE(numout,*) ' enstrophy conserving scheme ln_dynvor_ens = ', ln_dynvor_ens 725 WRITE(numout,*) ' mixed enstrophy/energy conserving scheme ln_dynvor_mix = ', ln_dynvor_mix 726 WRITE(numout,*) ' enstrophy and energy conserving scheme ln_dynvor_een = ', ln_dynvor_een 727 WRITE(numout,*) ' enstrophy and energy conserving scheme (old) ln_dynvor_een_old= ', ln_dynvor_een_old 630 WRITE(numout,*) ' energy conserving scheme ln_dynvor_ene = ', ln_dynvor_ene 631 WRITE(numout,*) ' enstrophy conserving scheme ln_dynvor_ens = ', ln_dynvor_ens 632 WRITE(numout,*) ' mixed enstrophy/energy conserving scheme ln_dynvor_mix = ', ln_dynvor_mix 633 WRITE(numout,*) ' enstrophy and energy conserving scheme ln_dynvor_een = ', ln_dynvor_een 634 WRITE(numout,*) ' e3f = averaging /4 (=0) or /sum(tmask) (=1) nn_een_e3f = ', nn_een_e3f 635 WRITE(numout,*) ' masked (=1) or unmasked(=0) vorticity ln_dynvor_msk = ', ln_dynvor_msk 728 636 ENDIF 729 637 638 !!gm this should be removed when choosing a unique strategy for fmask at the coast 730 639 ! If energy, enstrophy or mixed advection of momentum in vector form change the value for masks 731 640 ! at angles with three ocean points and one land point 641 IF(lwp) WRITE(numout,*) 642 IF(lwp) WRITE(numout,*) ' namlbc: change fmask value in the angles (T) ln_vorlat = ', ln_vorlat 732 643 IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN 733 644 DO jk = 1, jpk … … 743 654 ! 744 655 ENDIF 745 746 ioptio = 0 ! Control of vorticity scheme options 747 IF( ln_dynvor_ene ) ioptio = ioptio + 1 748 IF( ln_dynvor_ens ) ioptio = ioptio + 1 749 IF( ln_dynvor_mix ) ioptio = ioptio + 1 750 IF( ln_dynvor_een ) ioptio = ioptio + 1 751 IF( ln_dynvor_een_old ) ioptio = ioptio + 1 752 IF( lk_esopa ) ioptio = 1 753 656 !!gm end 657 658 ioptio = 0 ! type of scheme for vorticity (set nvor_scheme) 659 IF( ln_dynvor_ene ) THEN ; ioptio = ioptio + 1 ; nvor_scheme = np_ENE ; ENDIF 660 IF( ln_dynvor_ens ) THEN ; ioptio = ioptio + 1 ; nvor_scheme = np_ENS ; ENDIF 661 IF( ln_dynvor_mix ) THEN ; ioptio = ioptio + 1 ; nvor_scheme = np_MIX ; ENDIF 662 IF( ln_dynvor_een ) THEN ; ioptio = ioptio + 1 ; nvor_scheme = np_EEN ; ENDIF 663 ! 754 664 IF( ioptio /= 1 ) CALL ctl_stop( ' use ONE and ONLY one vorticity scheme' ) 755 756 ! ! Set nvor (type of scheme for vorticity) 757 IF( ln_dynvor_ene ) nvor = 0 758 IF( ln_dynvor_ens ) nvor = 1 759 IF( ln_dynvor_mix ) nvor = 2 760 IF( ln_dynvor_een .or. ln_dynvor_een_old ) nvor = 3 761 IF( lk_esopa ) nvor = -1 762 763 ! ! Set ncor, nrvm, ntot (type of vorticity) 764 IF(lwp) WRITE(numout,*) 765 ncor = 1 665 ! 666 IF(lwp) WRITE(numout,*) ! type of calculated vorticity (set ncor, nrvm, ntot) 667 ncor = np_COR 766 668 IF( ln_dynadv_vec ) THEN 767 669 IF(lwp) WRITE(numout,*) ' Vector form advection : vorticity = Coriolis + relative vorticity' 768 nrvm = 2769 ntot = 4670 nrvm = np_RVO ! relative vorticity 671 ntot = np_CRV ! relative + planetary vorticity 770 672 ELSE 771 673 IF(lwp) WRITE(numout,*) ' Flux form advection : vorticity = Coriolis + metric term' 772 nrvm = 3773 ntot = 5674 nrvm = np_MET ! metric term 675 ntot = np_CME ! Coriolis + metric term 774 676 ENDIF 775 677 776 678 IF(lwp) THEN ! Print the choice 777 679 WRITE(numout,*) 778 IF( nvor == 0 ) WRITE(numout,*) ' vorticity scheme : energy conserving scheme' 779 IF( nvor == 1 ) WRITE(numout,*) ' vorticity scheme : enstrophy conserving scheme' 780 IF( nvor == 2 ) WRITE(numout,*) ' vorticity scheme : mixed enstrophy/energy conserving scheme' 781 IF( nvor == 3 ) WRITE(numout,*) ' vorticity scheme : energy and enstrophy conserving scheme' 782 IF( nvor == -1 ) WRITE(numout,*) ' esopa test: use all lateral physics options' 680 IF( nvor_scheme == np_ENE ) WRITE(numout,*) ' vorticity scheme ==>> energy conserving scheme' 681 IF( nvor_scheme == np_ENS ) WRITE(numout,*) ' vorticity scheme ==>> enstrophy conserving scheme' 682 IF( nvor_scheme == np_MIX ) WRITE(numout,*) ' vorticity scheme ==>> mixed enstrophy/energy conserving scheme' 683 IF( nvor_scheme == np_EEN ) WRITE(numout,*) ' vorticity scheme ==>> energy and enstrophy conserving scheme' 783 684 ENDIF 784 685 ! -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r5737 r5777 49 49 !! 50 50 !! ** Method : The now vertical advection of momentum is given by: 51 !! w dz(u) = ua + 1/(e1 u*e2u*e3u) mk+1[ mi(e1t*e2t*wn) dk(un) ]52 !! w dz(v) = va + 1/(e1 v*e2v*e3v) mk+1[ mj(e1t*e2t*wn) dk(vn) ]51 !! w dz(u) = ua + 1/(e1e2u*e3u) mk+1[ mi(e1e2t*wn) dk(un) ] 52 !! w dz(v) = va + 1/(e1e2v*e3v) mk+1[ mj(e1e2t*wn) dk(vn) ] 53 53 !! Add this trend to the general trend (ua,va): 54 54 !! (ua,va) = (ua,va) + w dz(u,v) … … 183 183 IF( nn_timing == 1 ) CALL timing_start('dyn_zad_zts') 184 184 ! 185 CALL wrk_alloc( jpi,jpj,jpk, zwuw, zwvw, zww )186 CALL wrk_alloc( jpi,jpj,jpk,3, zus, zvs )185 CALL wrk_alloc( jpi,jpj,jpk, zwuw, zwvw, zww ) 186 CALL wrk_alloc( jpi,jpj,jpk,3, zus , zvs ) 187 187 ! 188 188 IF( kt == nit000 ) THEN … … 210 210 END DO 211 211 END DO 212 ! 213 ! Surface and bottom advective fluxes set to zero 214 DO jj = 2, jpjm1 212 213 DO jj = 2, jpjm1 ! Surface and bottom advective fluxes set to zero 215 214 DO ji = fs_2, fs_jpim1 ! vector opt. 215 !!gm missing ISF boundary condition 216 216 zwuw(ji,jj, 1 ) = 0._wp 217 217 zwvw(ji,jj, 1 ) = 0._wp … … 284 284 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 285 285 ! 286 CALL wrk_dealloc( jpi,jpj,jpk, zwuw, zwvw, zww )287 CALL wrk_dealloc( jpi,jpj,jpk,3, zus, zvs )286 CALL wrk_dealloc( jpi,jpj,jpk, zwuw, zwvw, zww ) 287 CALL wrk_dealloc( jpi,jpj,jpk,3, zus , zvs ) 288 288 ! 289 289 IF( nn_timing == 1 ) CALL timing_stop('dyn_zad_zts') -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
r5760 r5777 9 9 10 10 !!---------------------------------------------------------------------- 11 !! dyn_zdf : Update the momentum trend with the vertical diffusion12 !! dyn_zdf_init : initializations of the vertical diffusion scheme11 !! dyn_zdf : Update the momentum trend with the vertical diffusion 12 !! dyn_zdf_init : initializations of the vertical diffusion scheme 13 13 !!---------------------------------------------------------------------- 14 USE oce ! ocean dynamics and tracers variables 15 USE dom_oce ! ocean space and time domain variables 16 USE zdf_oce ! ocean vertical physics variables 17 18 USE dynzdf_exp ! vertical diffusion: explicit (dyn_zdf_exp routine) 19 USE dynzdf_imp ! vertical diffusion: implicit (dyn_zdf_imp routine) 20 21 USE ldfdyn_oce ! ocean dynamics: lateral physics 22 USE trd_oce ! trends: ocean variables 23 USE trddyn ! trend manager: dynamics 24 USE in_out_manager ! I/O manager 25 USE lib_mpp ! MPP library 26 USE prtctl ! Print control 27 USE wrk_nemo ! Memory Allocation 28 USE timing ! Timing 14 USE oce ! ocean dynamics and tracers variables 15 USE dom_oce ! ocean space and time domain variables 16 USE zdf_oce ! ocean vertical physics variables 17 USE dynzdf_exp ! vertical diffusion: explicit (dyn_zdf_exp routine) 18 USE dynzdf_imp ! vertical diffusion: implicit (dyn_zdf_imp routine) 19 USE ldfdyn ! lateral diffusion: eddy viscosity coef. 20 USE trd_oce ! trends: ocean variables 21 USE trddyn ! trend manager: dynamics 22 ! 23 USE in_out_manager ! I/O manager 24 USE lib_mpp ! MPP library 25 USE prtctl ! Print control 26 USE wrk_nemo ! Memory Allocation 27 USE timing ! Timing 29 28 30 29 IMPLICIT NONE … … 61 60 !!--------------------------------------------------------------------- 62 61 ! 63 IF( nn_timing == 1 ) CALL timing_start('dyn_zdf')62 IF( nn_timing == 1 ) CALL timing_start('dyn_zdf') 64 63 ! 65 64 ! ! set time step … … 79 78 CASE ( 1 ) ; CALL dyn_zdf_imp( kt, r2dt ) ! implicit scheme 80 79 ! 81 CASE ( -1 ) ! esopa: test all possibility with control print82 CALL dyn_zdf_exp( kt, r2dt )83 CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf0 - Ua: ', mask1=umask, &84 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )85 CALL dyn_zdf_imp( kt, r2dt )86 CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf1 - Ua: ', mask1=umask, &87 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )88 80 END SELECT 89 81 … … 96 88 ! ! print mean trends (used for debugging) 97 89 IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf - Ua: ', mask1=umask, & 98 &tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )99 !100 IF( nn_timing == 1 ) CALL timing_stop('dyn_zdf')90 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 91 ! 92 IF( nn_timing == 1 ) CALL timing_stop('dyn_zdf') 101 93 ! 102 94 END SUBROUTINE dyn_zdf … … 126 118 IF( ln_dynldf_hor .AND. ln_sco ) nzdf = 1 ! horizontal lateral physics in s-coordinate 127 119 ! 128 IF( lk_esopa ) nzdf = -1 ! Esopa key: All schemes used129 !130 120 IF(lwp) THEN ! Print the choice 131 121 WRITE(numout,*) 132 122 WRITE(numout,*) 'dyn_zdf_init : vertical dynamics physics scheme' 133 123 WRITE(numout,*) '~~~~~~~~~~~' 134 IF( nzdf == -1 ) WRITE(numout,*) ' ESOPA test All scheme used'135 124 IF( nzdf == 0 ) WRITE(numout,*) ' Explicit time-splitting scheme' 136 125 IF( nzdf == 1 ) WRITE(numout,*) ' Implicit (euler backward) scheme' -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r5120 r5777 209 209 !----------------------------------------------------------------------- 210 210 ! 211 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 212 DO jk = 2, jpkm1 211 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 213 212 DO jj = 2, jpjm1 214 213 DO ji = fs_2, fs_jpim1 ! vector opt. … … 309 308 !----------------------------------------------------------------------- 310 309 ! 311 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 312 DO jk = 2, jpkm1 310 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 313 311 DO jj = 2, jpjm1 314 312 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r5770 r5777 20 20 USE sbc_oce ! surface boundary condition: ocean 21 21 USE domvvl ! Variable volume 22 USE divcur ! hor. divergence and curl (div & cur routines) 23 USE restart ! only for lrst_oce 24 USE in_out_manager ! I/O manager 25 USE prtctl ! Print control 26 USE phycst 27 USE lbclnk ! ocean lateral boundary condition (or mpp link) 28 USE lib_mpp ! MPP library 22 USE divhor ! horizontal divergence 23 USE phycst ! physical constants 29 24 USE bdy_oce 30 25 USE bdy_par … … 36 31 USE asminc ! Assimilation increment 37 32 #endif 33 USE in_out_manager ! I/O manager 34 USE restart ! only for lrst_oce 35 USE prtctl ! Print control 36 USE lbclnk ! ocean lateral boundary condition (or mpp link) 37 USE lib_mpp ! MPP library 38 38 USE wrk_nemo ! Memory Allocation 39 39 USE timing ! Timing … … 66 66 !! by the time step. 67 67 !! 68 !! ** action : ssha :after sea surface height68 !! ** action : ssha, after sea surface height 69 69 !! 70 70 !! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling. 71 71 !!---------------------------------------------------------------------- 72 ! 73 REAL(wp), POINTER, DIMENSION(:,: ) :: zhdiv 74 INTEGER, INTENT(in) :: kt ! time step 72 INTEGER, INTENT(in) :: kt ! time step 75 73 ! 76 INTEGER :: jk ! dummy loop indice 77 REAL(wp) :: z2dt, z1_rau0 ! local scalars 78 !!---------------------------------------------------------------------- 79 ! 80 IF( nn_timing == 1 ) CALL timing_start('ssh_nxt') 74 INTEGER :: jk ! dummy loop indice 75 REAL(wp) :: z2dt, zcoef ! local scalars 76 REAL(wp), POINTER, DIMENSION(:,: ) :: zhdiv ! 2D workspace 77 !!---------------------------------------------------------------------- 78 ! 79 IF( nn_timing == 1 ) CALL timing_start('ssh_nxt') 81 80 ! 82 81 CALL wrk_alloc( jpi,jpj, zhdiv ) … … 88 87 ENDIF 89 88 ! 90 CALL div_ cur( kt ) ! Horizontal divergence & Relative vorticity89 CALL div_hor( kt ) ! Horizontal divergence 91 90 ! 92 91 z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog) … … 104 103 ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations. 105 104 ! 106 z 1_rau0= 0.5_wp * r1_rau0107 ssha(:,:) = ( sshb(:,:) - z2dt * ( z 1_rau0* ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * ssmask(:,:)105 zcoef = 0.5_wp * r1_rau0 106 ssha(:,:) = ( sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * ssmask(:,:) 108 107 109 108 #if ! defined key_dynspg_ts 110 109 ! These lines are not necessary with time splitting since 111 110 ! boundary condition on sea level is set during ts loop 112 # if defined key_agrif111 # if defined key_agrif 113 112 CALL agrif_ssh( kt ) 114 # endif115 # if defined key_bdy116 IF (lk_bdy) THEN117 CALL lbc_lnk( ssha, 'T', 1. ) ! Not sure that's necessary118 CALL bdy_ssh( ssha ) ! Duplicate sea level across open boundaries119 ENDIF 120 # endif113 # endif 114 # if defined key_bdy 115 IF( lk_bdy ) THEN 116 CALL lbc_lnk( ssha, 'T', 1. ) ! Not sure that's necessary 117 CALL bdy_ssh( ssha ) ! Duplicate sea level across open boundaries 118 ENDIF 119 # endif 121 120 #endif 122 121 123 122 #if defined key_asminc 124 ! ! Include the IAU weighted SSH increment 125 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 123 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN ! Include the IAU weighted SSH increment 126 124 CALL ssh_asm_inc( kt ) 127 125 ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 128 126 ENDIF 129 127 #endif 130 131 128 ! !------------------------------! 132 129 ! ! outputs ! … … 165 162 !!---------------------------------------------------------------------- 166 163 ! 167 IF( nn_timing == 1 ) CALL timing_start('wzv')164 IF( nn_timing == 1 ) CALL timing_start('wzv') 168 165 ! 169 166 IF( kt == nit000 ) THEN -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90
r3294 r5777 4 4 !! Ocean floats : trajectory computation using a 4th order Runge-Kutta 5 5 !!====================================================================== 6 #if defined key_floats || defined key_esopa6 #if defined key_floats 7 7 !!---------------------------------------------------------------------- 8 8 !! 'key_floats' float trajectories -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90
r4147 r5777 7 7 !! NEMO 1.0 ! 2002-11 (G. Madec, A. Bozec) F90: Free form and module 8 8 !!---------------------------------------------------------------------- 9 #if defined key_floats || defined key_esopa9 #if defined key_floats 10 10 !!---------------------------------------------------------------------- 11 11 !! 'key_floats' drifting floats -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90
r4624 r5777 7 7 !! NEMO 1.0 ! 2002-06 (A. Bozec) F90, Free form and module 8 8 !!---------------------------------------------------------------------- 9 #if defined key_floats || defined key_esopa9 #if defined key_floats 10 10 !!---------------------------------------------------------------------- 11 11 !! 'key_floats' float trajectories -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
r5737 r5777 4 4 !! Ocean floats : trajectory computation 5 5 !!====================================================================== 6 #if defined key_floats || defined key_esopa6 #if defined key_floats 7 7 !!---------------------------------------------------------------------- 8 8 !! 'key_floats' float trajectories -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90
r3294 r5777 4 4 !! Ocean floats : domain 5 5 !!====================================================================== 6 !! History : OPA ! 1998-07 (Y.Drillet, CLIPPER) Original code 7 !! NEMO_3.3.1 ! 2011-09 (C.Bricaud,S.Law-Chune Mercator-Ocean): 8 ! add Ariane convention, Comsecitc changes 9 !!---------------------------------------------------------------------- 10 #if defined key_floats || defined key_esopa 6 !! History : OPA ! 1998-07 (Y.Drillet, CLIPPER) Original code 7 !! NEMO 3.3 ! 2011-09 (C.Bricaud,S.Law-Chune Mercator-Ocean): add ARIANE convention + comsecitc changes 8 !!---------------------------------------------------------------------- 9 #if defined key_floats 11 10 !!---------------------------------------------------------------------- 12 11 !! 'key_floats' float trajectories -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90
r5217 r5777 2 2 !!====================================================================== 3 3 !! *** MODULE florst *** 4 !! 5 !! 6 !! write floats restart files 7 !! 4 !! Ocean floats : write floats restart files 8 5 !!====================================================================== 9 !! History : 10 !! 8.0 ! 99-09 (Y. Drillet) : Original code 11 !! ! 00-06 (J.-M. Molines) : Profiling floats for CLS 12 !! 8.5 ! 02-10 (A. Bozec) F90 : Free form and module 13 !! 3.2 ! 10-08 (slaw, cbricaud): netcdf outputs and others 6 !! History : OPA ! 1999-09 (Y. Drillet) : Original code 7 !! - ! 2000-06 (J.-M. Molines) : Profiling floats for CLS 8 !! NEMO 1.0 ! 2002-10 (A. Bozec) F90 : Free form and module 9 !! 3.2 ! 2010-08 (slaw, cbricaud): netcdf outputs and others 14 10 !!---------------------------------------------------------------------- 15 #if defined key_floats || defined key_esopa11 #if defined key_floats 16 12 !!---------------------------------------------------------------------- 17 13 !! 'key_floats' float trajectories 18 14 !!---------------------------------------------------------------------- 19 20 !! * Modules used21 15 USE flo_oce ! ocean drifting floats 22 16 USE dom_oce ! ocean space and time domain … … 37 31 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 38 32 !! $Id$ 39 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 40 34 !!---------------------------------------------------------------------- 41 42 35 CONTAINS 43 36 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
r5217 r5777 3 3 !! *** MODULE flowri *** 4 4 !! 5 !! write floats trajectory in ascii ln_flo_ascii = T 6 !! or in netcdf ( IOM or IOSPSL ) ln_flo_ascii = F 7 !! 8 !! 5 !! Ocean floats: write floats trajectory in ascii ln_flo_ascii = T 6 !! or in netcdf ( IOM or IOSPSL ) ln_flo_ascii = F 9 7 !!====================================================================== 10 !! History : 11 !! 8.0 ! 99-09 (Y. Drillet) : Original code 12 !! ! 00-06 (J.-M. Molines) : Profiling floats for CLS 13 !! 8.5 ! 02-10 (A. Bozec) F90 : Free form and module 14 !! 3.2 ! 10-08 (slaw, cbricaud): netcdf outputs and others 15 !!---------------------------------------------------------------------- 16 #if defined key_floats || defined key_esopa 8 !! History : OPA ! 1999-09 (Y. Drillet) : Original code 9 !! - ! 2000-06 (J.-M. Molines) : Profiling floats for CLS 10 !! NEMO 1.0 ! 2002-10 (A. Bozec) F90 : Free form and module 11 !! 3.2 ! 2010-08 (slaw, cbricaud): netcdf outputs and others 12 !!---------------------------------------------------------------------- 13 #if defined key_floats 17 14 !!---------------------------------------------------------------------- 18 15 !! 'key_floats' float trajectories 19 16 !!---------------------------------------------------------------------- 20 21 !! * Modules used22 17 USE flo_oce ! ocean drifting floats 23 18 USE oce ! ocean dynamics and tracers … … 30 25 USE iom ! I/O library 31 26 32 33 27 IMPLICIT NONE 34 28 PRIVATE … … 51 45 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 52 46 !! $Id$ 53 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 54 !!---------------------------------------------------------------------- 55 47 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 48 !!---------------------------------------------------------------------- 56 49 CONTAINS 57 50 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5737 r5777 903 903 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 904 904 ELSEIF( PRESENT(pv_r2d) ) THEN 905 !CDIR COLLAPSE906 905 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 907 !CDIR COLLAPSE908 906 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 909 907 ELSEIF( PRESENT(pv_r3d) ) THEN 910 !CDIR COLLAPSE911 908 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 912 !CDIR COLLAPSE913 909 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 914 910 ENDIF -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r5737 r5777 9 9 !! 3.3 ! 2010-04 (M. Leclair, G. Madec) modified LF-RA 10 10 !! - - ! 2010-10 (C. Ethe, G. Madec) TRC-TRA merge (T-S in 4D) 11 !! 3.7 ! 2014-01 (G. Madec) suppression of curl and hdiv from the restart 12 !! - ! 2014-12 (G. Madec) remove KPP scheme 11 13 !!---------------------------------------------------------------------- 12 14 … … 18 20 USE oce ! ocean dynamics and tracers 19 21 USE dom_oce ! ocean space and time domain 22 USE sbc_ice ! only lk_lim3 20 23 USE phycst ! physical constants 24 USE eosbn2 ! equation of state (eos bn2 routine) 25 USE trdmxl_oce ! ocean active mixed layer tracers trends variables 26 ! 21 27 USE in_out_manager ! I/O manager 22 28 USE iom ! I/O module 23 USE eosbn2 ! equation of state (eos bn2 routine)24 USE trdmxl_oce ! ocean active mixed layer tracers trends variables25 USE divcur ! hor. divergence and curl (div & cur routines)26 29 27 30 IMPLICIT NONE … … 130 133 CALL iom_rstput( kt, nitrst, numrow, 'tb' , tsb(:,:,:,jp_tem) ) 131 134 CALL iom_rstput( kt, nitrst, numrow, 'sb' , tsb(:,:,:,jp_sal) ) 132 CALL iom_rstput( kt, nitrst, numrow, 'rotb' , rotb )133 CALL iom_rstput( kt, nitrst, numrow, 'hdivb' , hdivb )134 135 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb ) 135 136 ! … … 138 139 CALL iom_rstput( kt, nitrst, numrow, 'tn' , tsn(:,:,:,jp_tem) ) 139 140 CALL iom_rstput( kt, nitrst, numrow, 'sn' , tsn(:,:,:,jp_sal) ) 140 CALL iom_rstput( kt, nitrst, numrow, 'rotn' , rotn )141 CALL iom_rstput( kt, nitrst, numrow, 'hdivn' , hdivn )142 141 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn ) 143 142 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop ) 144 #if defined key_zdfkpp145 CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd )146 #endif147 143 IF( kt == nitrst ) THEN 148 144 CALL iom_close( numrow ) ! close the restart file (only at last time step) … … 228 224 CALL iom_get( numror, jpdom_autoglo, 'tb' , tsb(:,:,:,jp_tem) ) 229 225 CALL iom_get( numror, jpdom_autoglo, 'sb' , tsb(:,:,:,jp_sal) ) 230 CALL iom_get( numror, jpdom_autoglo, 'rotb' , rotb )231 CALL iom_get( numror, jpdom_autoglo, 'hdivb' , hdivb )232 226 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb ) 233 227 ELSE … … 240 234 CALL iom_get( numror, jpdom_autoglo, 'sn' , tsn(:,:,:,jp_sal) ) 241 235 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn ) 242 IF( iom_varid( numror, 'rotn', ldstop = .FALSE. ) > 0 ) THEN243 CALL iom_get( numror, jpdom_autoglo, 'rotn' , rotn )244 CALL iom_get( numror, jpdom_autoglo, 'hdivn' , hdivn )245 ELSE246 CALL div_cur( 0 ) ! Horizontal divergence & Relative vorticity247 ENDIF248 236 IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 249 237 CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop ) ! now potential density … … 251 239 CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) ) 252 240 ENDIF 253 #if defined key_zdfkpp254 IF( iom_varid( numror, 'rhd', ldstop = .FALSE. ) > 0 ) THEN255 CALL iom_get( numror, jpdom_autoglo, 'rhd' , rhd ) ! now in situ density anomaly256 ELSE257 CALL eos( tsn, rhd, fsdept_n(:,:,:) ) ! compute rhd258 ENDIF259 #endif260 241 ! 261 242 IF( neuler == 0 ) THEN ! Euler restart (neuler=0) … … 263 244 ub (:,:,:) = un (:,:,:) 264 245 vb (:,:,:) = vn (:,:,:) 265 rotb (:,:,:) = rotn (:,:,:)266 hdivb(:,:,:) = hdivn(:,:,:)267 246 sshb (:,:) = sshn (:,:) 268 247 ! -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90
r4624 r5777 6 6 !! History : OPA ! 1997-07 (G. Madec) multi dimensional coefficients 7 7 !! NEMO 1.0 ! 2002-09 (G. Madec) F90: Free form and module 8 !! ----------------------------------------------------------------------9 10 !!---------------------------------------------------------------------- 11 !! ldf_dyn_init : initialization, namelist read, and parameters control 12 !! ldf_dyn_c3d : 3D eddy viscosity coefficient initialization13 !! ldf_dyn_ c2d : 2D eddy viscosity coefficient initialization14 !! ldf_dyn _c1d : 1D eddy viscosity coefficient initialization8 !! 3.7 ! 2014-01 (F. Lemarie, G. Madec) restructuration/simplification of ahm specification, 9 !! ! add velocity dependent coefficient and optional read in file 10 !!---------------------------------------------------------------------- 11 12 !!---------------------------------------------------------------------- 13 !! ldf_dyn_init : initialization, namelist read, and parameters control 14 !! ldf_dyn : update lateral eddy viscosity coefficients at each time step 15 15 !!---------------------------------------------------------------------- 16 16 USE oce ! ocean dynamics and tracers 17 17 USE dom_oce ! ocean space and time domain 18 USE ldfdyn_oce ! ocean dynamics lateral physics19 18 USE phycst ! physical constants 20 USE ldf slp ! ???21 USE ioipsl19 USE ldfc1d_c2d ! lateral diffusion: 1D and 2D cases 20 ! 22 21 USE in_out_manager ! I/O manager 22 USE iom ! I/O module for ehanced bottom friction file 23 USE timing ! Timing 23 24 USE lib_mpp ! distribued memory computing library 24 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 28 29 PRIVATE 29 30 30 PUBLIC ldf_dyn_init ! called by opa.F90 31 32 INTERFACE ldf_zpf 33 MODULE PROCEDURE ldf_zpf_1d, ldf_zpf_1d_3d, ldf_zpf_3d 34 END INTERFACE 31 PUBLIC ldf_dyn_init ! called by nemogcm.F90 32 PUBLIC ldf_dyn ! called by step.F90 33 34 ! !!* Namelist namdyn_ldf : lateral mixing on momentum * 35 LOGICAL , PUBLIC :: ln_dynldf_lap !: laplacian operator 36 LOGICAL , PUBLIC :: ln_dynldf_blp !: bilaplacian operator 37 LOGICAL , PUBLIC :: ln_dynldf_lev !: iso-level direction 38 LOGICAL , PUBLIC :: ln_dynldf_hor !: horizontal (geopotential) direction 39 LOGICAL , PUBLIC :: ln_dynldf_iso !: iso-neutral direction 40 INTEGER , PUBLIC :: nn_ahm_ijk_t !: choice of time & space variations of the lateral eddy viscosity coef. 41 REAL(wp), PUBLIC :: rn_ahm_0 !: lateral laplacian eddy viscosity [m2/s] 42 REAL(wp), PUBLIC :: rn_ahm_b !: lateral laplacian background eddy viscosity [m2/s] 43 REAL(wp), PUBLIC :: rn_bhm_0 !: lateral bilaplacian eddy viscosity [m4/s] 44 45 LOGICAL , PUBLIC :: l_ldfdyn_time !: flag for time variation of the lateral eddy viscosity coef. 46 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ahmt, ahmf !: eddy diffusivity coef. at U- and V-points [m2/s or m4/s] 48 49 REAL(wp) :: r1_12 = 1._wp / 12._wp ! =1/12 50 REAL(wp) :: r1_4 = 0.25_wp ! =1/4 51 REAL(wp) :: r1_288 = 1._wp / 288._wp ! =1/( 12^2 * 2 ) 35 52 36 53 !! * Substitutions 37 54 # include "domzgr_substitute.h90" 38 !!---------------------------------------------------------------------- 39 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 55 # include "vectopt_loop_substitute.h90" 56 !!---------------------------------------------------------------------- 57 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 40 58 !! $Id$ 41 59 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 49 67 !! ** Purpose : set the horizontal ocean dynamics physics 50 68 !! 51 !! ** Method : 52 !! - default option : ahm = constant coef. = rn_ahm_0 (namelist) 53 !! - 'key_dynldf_c1d': ahm = F(depth) see ldf_dyn_c1d.h90 54 !! - 'key_dynldf_c2d': ahm = F(latitude,longitude) see ldf_dyn_c2d.h90 55 !! - 'key_dynldf_c3d': ahm = F(latitude,longitude,depth) see ldf_dyn_c3d.h90 56 !! 57 !! N.B. User defined include files. By default, 3d and 2d coef. 58 !! are set to a constant value given in the namelist and the 1d 59 !! coefficients are initialized to a hyperbolic tangent vertical 60 !! profile. 61 !! 62 !! Reference : Madec, G. and M. Imbard, 1996: Climate Dynamics, 12, 381-388. 63 !!---------------------------------------------------------------------- 64 INTEGER :: ioptio ! ??? 65 INTEGER :: ios ! Local : output status for namelist read 66 LOGICAL :: ll_print = .FALSE. ! Logical flag for printing viscosity coef. 67 !! 68 NAMELIST/namdyn_ldf/ ln_dynldf_lap , ln_dynldf_bilap, & 69 & ln_dynldf_level, ln_dynldf_hor , ln_dynldf_iso, & 70 & rn_ahm_0_lap , rn_ahmb_0 , rn_ahm_0_blp , & 71 & rn_cmsmag_1 , rn_cmsmag_2 , rn_cmsh, & 72 & rn_ahm_m_lap , rn_ahm_m_blp 73 74 !!---------------------------------------------------------------------- 75 69 !! ** Method : the eddy viscosity coef. specification depends on: 70 !! - the operator: 71 !! ln_dynldf_lap = T laplacian operator 72 !! ln_dynldf_blp = T bilaplacian operator 73 !! - the parameter nn_ahm_ijk_t: 74 !! nn_ahm_ijk_t = 0 => = constant 75 !! = 10 => = F(z) : = constant with a reduction of 1/4 with depth 76 !! =-20 => = F(i,j) = shape read in 'eddy_viscosity.nc' file 77 !! = 20 = F(i,j) = F(e1,e2) or F(e1^3,e2^3) (lap or bilap case) 78 !! =-30 => = F(i,j,k) = shape read in 'eddy_viscosity.nc' file 79 !! = 30 = F(i,j,k) = 2D (case 20) + decrease with depth (case 10) 80 !! = 31 = F(i,j,k,t) = F(local velocity) ( |u|e /12 laplacian operator 81 !! or |u|e^3/12 bilaplacian operator ) 82 !!---------------------------------------------------------------------- 83 INTEGER :: jk ! dummy loop indices 84 INTEGER :: ierr, inum, ios ! local integer 85 REAL(wp) :: zah0 ! local scalar 86 ! 87 NAMELIST/namdyn_ldf/ ln_dynldf_lap, ln_dynldf_blp, & 88 & ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso, & 89 & nn_ahm_ijk_t , rn_ahm_0, rn_ahm_b, rn_bhm_0 90 !!---------------------------------------------------------------------- 91 ! 76 92 REWIND( numnam_ref ) ! Namelist namdyn_ldf in reference namelist : Lateral physics 77 93 READ ( numnam_ref, namdyn_ldf, IOSTAT = ios, ERR = 901) … … 87 103 WRITE(numout,*) 'ldf_dyn : lateral momentum physics' 88 104 WRITE(numout,*) '~~~~~~~' 89 WRITE(numout,*) ' Namelist namdyn_ldf : set lateral mixing parameters' 90 WRITE(numout,*) ' laplacian operator ln_dynldf_lap = ', ln_dynldf_lap 91 WRITE(numout,*) ' bilaplacian operator ln_dynldf_bilap = ', ln_dynldf_bilap 92 WRITE(numout,*) ' iso-level ln_dynldf_level = ', ln_dynldf_level 93 WRITE(numout,*) ' horizontal (geopotential) ln_dynldf_hor = ', ln_dynldf_hor 94 WRITE(numout,*) ' iso-neutral ln_dynldf_iso = ', ln_dynldf_iso 95 WRITE(numout,*) ' horizontal laplacian eddy viscosity rn_ahm_0_lap = ', rn_ahm_0_lap 96 WRITE(numout,*) ' background viscosity rn_ahmb_0 = ', rn_ahmb_0 97 WRITE(numout,*) ' horizontal bilaplacian eddy viscosity rn_ahm_0_blp = ', rn_ahm_0_blp 98 WRITE(numout,*) ' upper limit for laplacian eddy visc rn_ahm_m_lap = ', rn_ahm_m_lap 99 WRITE(numout,*) ' upper limit for bilap eddy viscosity rn_ahm_m_blp = ', rn_ahm_m_blp 100 101 ENDIF 102 103 ahm0 = rn_ahm_0_lap ! OLD namelist variables defined from DOCTOR namelist variables 104 ahmb0 = rn_ahmb_0 105 ahm0_blp = rn_ahm_0_blp 106 107 ! ... check of lateral diffusive operator on tracers 108 ! ==> will be done in trazdf module 109 110 ! ... Space variation of eddy coefficients 111 ioptio = 0 112 #if defined key_dynldf_c3d 113 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( latitude, longitude, depth)' 114 ioptio = ioptio+1 115 #endif 116 #if defined key_dynldf_c2d 117 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( latitude, longitude)' 118 ioptio = ioptio+1 119 #endif 120 #if defined key_dynldf_c1d 121 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( depth )' 122 ioptio = ioptio+1 123 IF( ln_sco ) CALL ctl_stop( 'key_dynldf_c1d cannot be used in s-coordinate (ln_sco)' ) 124 #endif 125 IF( ioptio == 0 ) THEN 126 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = constant (default option)' 127 ELSEIF( ioptio > 1 ) THEN 128 CALL ctl_stop( 'use only one of the following keys: key_dynldf_c3d, key_dynldf_c2d, key_dynldf_c1d' ) 129 ENDIF 130 131 132 IF( ln_dynldf_bilap ) THEN 133 IF(lwp) WRITE(numout,*) ' biharmonic momentum diffusion' 134 IF( .NOT. ln_dynldf_lap ) ahm0 = ahm0_blp ! Allow spatially varying coefs, which use ahm0 as input 135 IF( ahm0_blp > 0 .AND. .NOT. lk_esopa ) CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be negative' ) 136 ELSE 137 IF(lwp) WRITE(numout,*) ' harmonic momentum diff. (default)' 138 IF( ahm0 < 0 .AND. .NOT. lk_esopa ) CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be positive' ) 139 ENDIF 140 141 142 ! Lateral eddy viscosity 143 ! ====================== 144 #if defined key_dynldf_c3d 145 CALL ldf_dyn_c3d( ll_print ) ! ahm = 3D coef. = F( longitude, latitude, depth ) 146 #elif defined key_dynldf_c2d 147 CALL ldf_dyn_c2d( ll_print ) ! ahm = 1D coef. = F( longitude, latitude ) 148 #elif defined key_dynldf_c1d 149 CALL ldf_dyn_c1d( ll_print ) ! ahm = 1D coef. = F( depth ) 150 #else 151 ! Constant coefficients 152 IF(lwp) WRITE(numout,*) 153 IF(lwp) WRITE(numout,*) 'inildf: constant eddy viscosity coef. ' 154 IF(lwp) WRITE(numout,*) '~~~~~~' 155 IF(lwp) WRITE(numout,*) ' ahm1 = ahm2 = ahm0 = ',ahm0 156 #endif 157 nkahm_smag = 0 158 #if defined key_dynldf_smag 159 nkahm_smag = 1 160 #endif 161 105 WRITE(numout,*) ' Namelist nam_dynldf : set lateral mixing parameters' 106 ! 107 WRITE(numout,*) ' type :' 108 WRITE(numout,*) ' laplacian operator ln_dynldf_lap = ', ln_dynldf_lap 109 WRITE(numout,*) ' bilaplacian operator ln_dynldf_blp = ', ln_dynldf_blp 110 ! 111 WRITE(numout,*) ' direction of action :' 112 WRITE(numout,*) ' iso-level ln_dynldf_lev = ', ln_dynldf_lev 113 WRITE(numout,*) ' horizontal (geopotential) ln_dynldf_hor = ', ln_dynldf_hor 114 WRITE(numout,*) ' iso-neutral ln_dynldf_iso = ', ln_dynldf_iso 115 ! 116 WRITE(numout,*) ' coefficients :' 117 WRITE(numout,*) ' type of time-space variation nn_ahm_ijk_t = ', nn_ahm_ijk_t 118 WRITE(numout,*) ' lateral laplacian eddy viscosity rn_ahm_0_lap = ', rn_ahm_0, ' m2/s' 119 WRITE(numout,*) ' background viscosity (iso case) rn_ahm_b = ', rn_ahm_b, ' m2/s' 120 WRITE(numout,*) ' lateral bilaplacian eddy viscosity rn_ahm_0_blp = ', rn_bhm_0, ' m4/s' 121 ENDIF 122 123 ! ! Parameter control 124 IF( .NOT.ln_dynldf_lap .AND. .NOT.ln_dynldf_blp ) THEN 125 IF(lwp) WRITE(numout,*) ' No viscous operator selected. ahmt and ahmf are not allocated' 126 l_ldfdyn_time = .FALSE. 127 RETURN 128 ENDIF 129 ! 130 IF( ln_dynldf_blp .AND. ln_dynldf_iso ) THEN ! iso-neutral bilaplacian not implemented 131 CALL ctl_stop( 'dyn_ldf_init: iso-neutral bilaplacian not coded yet' ) 132 ENDIF 133 134 ! ... Space/Time variation of eddy coefficients 135 ! ! allocate the ahm arrays 136 ALLOCATE( ahmt(jpi,jpj,jpk) , ahmf(jpi,jpj,jpk) , STAT=ierr ) 137 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate arrays') 138 ! 139 ahmt(:,:,jpk) = 0._wp ! last level always 0 140 ahmf(:,:,jpk) = 0._wp 141 ! 142 ! ! value of eddy mixing coef. 143 IF ( ln_dynldf_lap ) THEN ; zah0 = rn_ahm_0 ! laplacian operator 144 ELSEIF( ln_dynldf_blp ) THEN ; zah0 = ABS( rn_bhm_0 ) ! bilaplacian operator 145 ELSE ! NO viscous operator 146 CALL ctl_warn( 'ldf_dyn_init: No lateral viscous operator used ' ) 147 ENDIF 148 ! 149 l_ldfdyn_time = .FALSE. ! no time variation except in case defined below 150 ! 151 IF( ln_dynldf_lap .OR. ln_dynldf_blp ) THEN ! only if a lateral diffusion operator is used 152 ! 153 SELECT CASE( nn_ahm_ijk_t ) ! Specification of space time variations of ahmt, ahmf 154 ! 155 CASE( 0 ) !== constant ==! 156 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = constant ' 157 ahmt(:,:,:) = zah0 * tmask(:,:,:) 158 ahmf(:,:,:) = zah0 * fmask(:,:,:) 159 ! 160 CASE( 10 ) !== fixed profile ==! 161 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( depth )' 162 ahmt(:,:,1) = zah0 * tmask(:,:,1) ! constant surface value 163 ahmf(:,:,1) = zah0 * fmask(:,:,1) 164 CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf ) 165 ! 166 CASE ( -20 ) !== fixed horizontal shape read in file ==! 167 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F(i,j) read in eddy_viscosity.nc file' 168 CALL iom_open( 'eddy_viscosity_2D.nc', inum ) 169 CALL iom_get ( inum, jpdom_data, 'ahmt_2d', ahmt(:,:,1) ) 170 CALL iom_get ( inum, jpdom_data, 'ahmf_2d', ahmf(:,:,1) ) 171 CALL iom_close( inum ) 172 !!gm Question : info for LAP or BLP case to take into account the SQRT in the bilaplacian case ??? 173 !! do we introduce a scaling by the max value of the array, and then multiply by zah0 ???? 174 !! better: check that the max is <=1 i.e. it is a shape from 0 to 1, not a coef that has physical dimension 175 DO jk = 2, jpkm1 176 ahmt(:,:,jk) = ahmt(:,:,1) * tmask(:,:,jk) 177 ahmf(:,:,jk) = ahmf(:,:,1) * fmask(:,:,jk) 178 END DO 179 ! 180 CASE( 20 ) !== fixed horizontal shape ==! 181 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap. or blp. case)' 182 IF( ln_dynldf_lap ) CALL ldf_c2d( 'DYN', 'LAP', zah0, ahmt, ahmf ) ! surface value proportional to scale factor 183 IF( ln_dynldf_blp ) CALL ldf_c2d( 'DYN', 'BLP', zah0, ahmt, ahmf ) ! surface value proportional to scale factor^3 184 ! 185 CASE( -30 ) !== fixed 3D shape read in file ==! 186 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file' 187 CALL iom_open( 'eddy_viscosity_3D.nc', inum ) 188 CALL iom_get ( inum, jpdom_data, 'ahmt_3d', ahmt ) 189 CALL iom_get ( inum, jpdom_data, 'ahmf_3d', ahmf ) 190 CALL iom_close( inum ) 191 !!gm Question : info for LAP or BLP case to take into account the SQRT in the bilaplacian case ???? 192 !! do we introduce a scaling by the max value of the array, and then multiply by zah0 ???? 193 DO jk = 1, jpkm1 194 ahmt(:,:,jk) = ahmt(:,:,jk) * tmask(:,:,jk) 195 ahmf(:,:,jk) = ahmf(:,:,jk) * fmask(:,:,jk) 196 END DO 197 ! 198 CASE( 30 ) !== fixed 3D shape ==! 199 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( latitude, longitude, depth )' 200 IF( ln_dynldf_lap ) CALL ldf_c2d( 'DYN', 'LAP', zah0, ahmt, ahmf ) ! surface value proportional to scale factor 201 IF( ln_dynldf_blp ) CALL ldf_c2d( 'DYN', 'BLP', zah0, ahmt, ahmf ) ! surface value proportional to scale factor 202 ! ! reduction with depth 203 CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf ) 204 ! 205 CASE( 31 ) !== time varying 3D field ==! 206 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( latitude, longitude, depth , time )' 207 IF(lwp) WRITE(numout,*) ' proportional to the velocity : |u|e/12 or |u|e^3/12' 208 ! 209 l_ldfdyn_time = .TRUE. ! will be calculated by call to ldf_dyn routine in step.F90 210 ! 211 CASE DEFAULT 212 CALL ctl_stop('ldf_dyn_init: wrong choice for nn_ahm_ijk_t, the type of space-time variation of ahm') 213 END SELECT 214 ! 215 IF( ln_dynldf_blp .AND. .NOT. l_ldfdyn_time ) THEN ! bilapcian and no time variation: 216 ahmt(:,:,:) = SQRT( ahmt(:,:,:) ) ! take the square root of the coefficient 217 ahmf(:,:,:) = SQRT( ahmf(:,:,:) ) 218 ENDIF 219 ! 220 ENDIF 162 221 ! 163 222 END SUBROUTINE ldf_dyn_init 164 223 165 #if defined key_dynldf_c3d 166 # include "ldfdyn_c3d.h90" 167 #elif defined key_dynldf_c2d 168 # include "ldfdyn_c2d.h90" 169 #elif defined key_dynldf_c1d 170 # include "ldfdyn_c1d.h90" 171 #endif 172 173 174 SUBROUTINE ldf_zpf_1d( ld_print, pdam, pwam, pbot, pdep, pah ) 175 !!---------------------------------------------------------------------- 176 !! *** ROUTINE ldf_zpf *** 177 !! 178 !! ** Purpose : vertical adimensional profile for eddy coefficient 179 !! 180 !! ** Method : 1D eddy viscosity coefficients ( depth ) 181 !!---------------------------------------------------------------------- 182 LOGICAL , INTENT(in ) :: ld_print ! If true, output arrays on numout 183 REAL(wp), INTENT(in ) :: pdam ! depth of the inflection point 184 REAL(wp), INTENT(in ) :: pwam ! width of inflection 185 REAL(wp), INTENT(in ) :: pbot ! bottom value (0<pbot<= 1) 186 REAL(wp), INTENT(in ), DIMENSION(jpk) :: pdep ! depth of the gridpoint (T, U, V, F) 187 REAL(wp), INTENT(inout), DIMENSION(jpk) :: pah ! adimensional vertical profile 188 !! 189 INTEGER :: jk ! dummy loop indices 190 REAL(wp) :: zm00, zm01, zmhb, zmhs ! temporary scalars 191 !!---------------------------------------------------------------------- 192 193 zm00 = TANH( ( pdam - gdept_1d(1 ) ) / pwam ) 194 zm01 = TANH( ( pdam - gdept_1d(jpkm1) ) / pwam ) 195 zmhs = zm00 / zm01 196 zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01 197 198 DO jk = 1, jpk 199 pah(jk) = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(jk) ) / pwam ) ) 200 END DO 201 202 IF(lwp .AND. ld_print ) THEN ! Control print 203 WRITE(numout,*) 204 WRITE(numout,*) ' ahm profile : ' 205 WRITE(numout,*) 206 WRITE(numout,'(" jk ahm "," depth t-level " )') 207 DO jk = 1, jpk 208 WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(jk), pdep(jk) 209 END DO 210 ENDIF 211 ! 212 END SUBROUTINE ldf_zpf_1d 213 214 215 SUBROUTINE ldf_zpf_1d_3d( ld_print, pdam, pwam, pbot, pdep, pah ) 216 !!---------------------------------------------------------------------- 217 !! *** ROUTINE ldf_zpf *** 218 !! 219 !! ** Purpose : vertical adimensional profile for eddy coefficient 220 !! 221 !! ** Method : 1D eddy viscosity coefficients ( depth ) 222 !!---------------------------------------------------------------------- 223 LOGICAL , INTENT(in ) :: ld_print ! If true, output arrays on numout 224 REAL(wp), INTENT(in ) :: pdam ! depth of the inflection point 225 REAL(wp), INTENT(in ) :: pwam ! width of inflection 226 REAL(wp), INTENT(in ) :: pbot ! bottom value (0<pbot<= 1) 227 REAL(wp), INTENT(in ), DIMENSION (:) :: pdep ! depth of the gridpoint (T, U, V, F) 228 REAL(wp), INTENT(inout), DIMENSION (:,:,:) :: pah ! adimensional vertical profile 229 !! 230 INTEGER :: jk ! dummy loop indices 231 REAL(wp) :: zm00, zm01, zmhb, zmhs, zcf ! temporary scalars 232 !!---------------------------------------------------------------------- 233 234 zm00 = TANH( ( pdam - gdept_1d(1 ) ) / pwam ) 235 zm01 = TANH( ( pdam - gdept_1d(jpkm1) ) / pwam ) 236 zmhs = zm00 / zm01 237 zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01 238 239 DO jk = 1, jpk 240 zcf = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(jk) ) / pwam ) ) 241 pah(:,:,jk) = zcf 242 END DO 243 244 IF(lwp .AND. ld_print ) THEN ! Control print 245 WRITE(numout,*) 246 WRITE(numout,*) ' ahm profile : ' 247 WRITE(numout,*) 248 WRITE(numout,'(" jk ahm "," depth t-level " )') 249 DO jk = 1, jpk 250 WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(1,1,jk), pdep(jk) 251 END DO 252 ENDIF 253 ! 254 END SUBROUTINE ldf_zpf_1d_3d 255 256 257 SUBROUTINE ldf_zpf_3d( ld_print, pdam, pwam, pbot, pdep, pah ) 258 !!---------------------------------------------------------------------- 259 !! *** ROUTINE ldf_zpf *** 260 !! 261 !! ** Purpose : vertical adimensional profile for eddy coefficient 262 !! 263 !! ** Method : 3D for partial step or s-coordinate 264 !!---------------------------------------------------------------------- 265 LOGICAL , INTENT(in ) :: ld_print ! If true, output arrays on numout 266 REAL(wp), INTENT(in ) :: pdam ! depth of the inflection point 267 REAL(wp), INTENT(in ) :: pwam ! width of inflection 268 REAL(wp), INTENT(in ) :: pbot ! bottom value (0<pbot<= 1) 269 REAL(wp), INTENT(in ), DIMENSION (:,:,:) :: pdep ! dep of the gridpoint (T, U, V, F) 270 REAL(wp), INTENT(inout), DIMENSION (:,:,:) :: pah ! adimensional vertical profile 271 !! 272 INTEGER :: jk ! dummy loop indices 273 REAL(wp) :: zm00, zm01, zmhb, zmhs ! temporary scalars 274 !!---------------------------------------------------------------------- 275 276 zm00 = TANH( ( pdam - gdept_1d(1 ) ) / pwam ) 277 zm01 = TANH( ( pdam - gdept_1d(jpkm1) ) / pwam ) 278 zmhs = zm00 / zm01 279 zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01 280 281 DO jk = 1, jpk 282 pah(:,:,jk) = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(:,:,jk) ) / pwam ) ) 283 END DO 284 285 IF(lwp .AND. ld_print ) THEN ! Control print 286 WRITE(numout,*) 287 WRITE(numout,*) ' ahm profile : ' 288 WRITE(numout,*) 289 WRITE(numout,'(" jk ahm "," depth t-level " )') 290 DO jk = 1, jpk 291 WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(1,1,jk), pdep(1,1,jk) 292 END DO 293 ENDIF 294 ! 295 END SUBROUTINE ldf_zpf_3d 224 225 SUBROUTINE ldf_dyn( kt ) 226 !!---------------------------------------------------------------------- 227 !! *** ROUTINE ldf_dyn *** 228 !! 229 !! ** Purpose : update at kt the momentum lateral mixing coeff. (ahmt and ahmf) 230 !! 231 !! ** Method : time varying eddy viscosity coefficients: 232 !! 233 !! nn_ahm_ijk_t = 31 ahmt, ahmf = F(i,j,k,t) = F(local velocity) 234 !! ( |u|e /12 or |u|e^3/12 for laplacian or bilaplacian operator ) 235 !! BLP case : sqrt of the eddy coef, since bilaplacian is en re-entrant laplacian 236 !! 237 !! ** action : ahmt, ahmf update at each time step 238 !!---------------------------------------------------------------------- 239 INTEGER, INTENT(in) :: kt ! time step index 240 ! 241 INTEGER :: ji, jj, jk ! dummy loop indices 242 REAL(wp) :: zu2pv2_ij_p1, zu2pv2_ij, zu2pv2_ij_m1, zetmax, zefmax ! local scalar 243 !!---------------------------------------------------------------------- 244 ! 245 IF( nn_timing == 1 ) CALL timing_start('ldf_dyn') 246 ! 247 SELECT CASE( nn_ahm_ijk_t ) !== Eddy vicosity coefficients ==! 248 ! 249 CASE( 31 ) !== time varying 3D field ==! = F( local velocity ) 250 ! 251 IF( ln_dynldf_lap ) THEN ! laplacian operator : |u| e /12 = |u/144| e 252 DO jk = 1, jpkm1 253 DO jj = 2, jpjm1 254 DO ji = fs_2, fs_jpim1 255 zu2pv2_ij_p1 = ub(ji ,jj+1,jk) * ub(ji ,jj+1,jk) + vb(ji+1,jj ,jk) * vb(ji+1,jj ,jk) 256 zu2pv2_ij = ub(ji ,jj ,jk) * ub(ji ,jj ,jk) + vb(ji ,jj ,jk) * vb(ji ,jj ,jk) 257 zu2pv2_ij_m1 = ub(ji-1,jj ,jk) * ub(ji-1,jj ,jk) + vb(ji ,jj-1,jk) * vb(ji ,jj-1,jk) 258 zetmax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 259 zefmax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 260 ahmt(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zetmax * tmask(ji,jj,jk) ! 288= 12*12 * 2 261 ahmf(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zefmax * fmask(ji,jj,jk) 262 END DO 263 END DO 264 END DO 265 ELSEIF( ln_dynldf_blp ) THEN ! bilaplacian operator : sqrt( |u| e^3 /12 ) = sqrt( |u/144| e ) * e 266 DO jk = 1, jpkm1 267 DO jj = 2, jpjm1 268 DO ji = fs_2, fs_jpim1 269 zu2pv2_ij_p1 = ub(ji ,jj+1,jk) * ub(ji ,jj+1,jk) + vb(ji+1,jj ,jk) * vb(ji+1,jj ,jk) 270 zu2pv2_ij = ub(ji ,jj ,jk) * ub(ji ,jj ,jk) + vb(ji ,jj ,jk) * vb(ji ,jj ,jk) 271 zu2pv2_ij_m1 = ub(ji-1,jj ,jk) * ub(ji-1,jj ,jk) + vb(ji ,jj-1,jk) * vb(ji ,jj-1,jk) 272 zetmax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 273 zefmax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 274 ahmt(ji,jj,jk) = SQRT( SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zetmax ) * zetmax * tmask(ji,jj,jk) 275 ahmf(ji,jj,jk) = SQRT( SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zefmax ) * zefmax * fmask(ji,jj,jk) 276 END DO 277 END DO 278 END DO 279 ENDIF 280 ! 281 CALL lbc_lnk( ahmt, 'T', 1. ) ; CALL lbc_lnk( ahmf, 'F', 1. ) 282 ! 283 END SELECT 284 ! 285 CALL iom_put( "ahmt_2d", ahmt(:,:,1) ) ! surface u-eddy diffusivity coeff. 286 CALL iom_put( "ahmf_2d", ahmf(:,:,1) ) ! surface v-eddy diffusivity coeff. 287 CALL iom_put( "ahmt_3d", ahmt(:,:,:) ) ! 3D u-eddy diffusivity coeff. 288 CALL iom_put( "ahmf_3d", ahmf(:,:,:) ) ! 3D v-eddy diffusivity coeff. 289 ! 290 IF( nn_timing == 1 ) CALL timing_stop('ldf_dyn') 291 ! 292 END SUBROUTINE ldf_dyn 296 293 297 294 !!====================================================================== -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r5758 r5777 22 22 USE oce ! ocean dynamics and tracers 23 23 USE dom_oce ! ocean space and time domain 24 !!gm 25 ! USE ldfdyn ! lateral diffusion: eddy viscosity coef. 26 !!gm to be removed 27 USE ldfdyn_oce ! lateral diffusion: eddy viscosity coef. 28 !!gm 24 USE ldfdyn ! lateral diffusion: eddy viscosity coef. 29 25 USE phycst ! physical constants 30 26 USE zdfmxl ! mixed layer depth -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
r5758 r5777 43 43 PUBLIC ldf_eiv_dia ! called by traldf_iso and traldf_iso_triad.F90 44 44 45 ! 46 ! 47 LOGICAL , PUBLIC :: ln_traldf_lap 48 LOGICAL , PUBLIC :: ln_traldf_blp 49 ! !=Direction of action =!50 LOGICAL , PUBLIC :: ln_traldf_lev 51 LOGICAL , PUBLIC :: ln_traldf_hor 52 ! LOGICAL , PUBLIC :: ln_traldf_iso!: iso-neutral direction (see ldfslp)53 ! LOGICAL , PUBLIC :: ln_traldf_triad!: griffies triad scheme (see ldfslp)54 LOGICAL , PUBLIC :: ln_traldf_msc 55 ! LOGICAL , PUBLIC :: ln_triad_iso!: pure horizontal mixing in ML (see ldfslp)56 ! LOGICAL , PUBLIC :: ln_botmix_triad!: mixing on bottom (see ldfslp)57 ! REAL(wp), PUBLIC :: rn_sw_triad!: =1/0 switching triad / all 4 triads used (see ldfslp)58 ! REAL(wp), PUBLIC :: rn_slpmax!: slope limit (see ldfslp)59 ! 60 INTEGER , PUBLIC :: nn_aht_ijk_t !: ?????? !!gm61 REAL(wp), PUBLIC :: rn_aht_0 62 REAL(wp), PUBLIC :: rn_bht_0 63 64 ! 65 ! 66 LOGICAL , PUBLIC :: ln_ldfeiv 67 LOGICAL , PUBLIC :: ln_ldfeiv_dia 68 ! !=Coefficients =!69 INTEGER , PUBLIC :: nn_aei_ijk_t 70 REAL(wp), PUBLIC :: rn_aeiv_0 45 ! !!* Namelist namtra_ldf : lateral mixing on tracers * 46 ! != Operator type =! 47 LOGICAL , PUBLIC :: ln_traldf_lap !: laplacian operator 48 LOGICAL , PUBLIC :: ln_traldf_blp !: bilaplacian operator 49 ! != Direction of action =! 50 LOGICAL , PUBLIC :: ln_traldf_lev !: iso-level direction 51 LOGICAL , PUBLIC :: ln_traldf_hor !: horizontal (geopotential) direction 52 ! LOGICAL , PUBLIC :: ln_traldf_iso !: iso-neutral direction (see ldfslp) 53 ! LOGICAL , PUBLIC :: ln_traldf_triad !: griffies triad scheme (see ldfslp) 54 LOGICAL , PUBLIC :: ln_traldf_msc !: Method of Stabilizing Correction 55 ! LOGICAL , PUBLIC :: ln_triad_iso !: pure horizontal mixing in ML (see ldfslp) 56 ! LOGICAL , PUBLIC :: ln_botmix_triad !: mixing on bottom (see ldfslp) 57 ! REAL(wp), PUBLIC :: rn_sw_triad !: =1/0 switching triad / all 4 triads used (see ldfslp) 58 ! REAL(wp), PUBLIC :: rn_slpmax !: slope limit (see ldfslp) 59 ! != Coefficients =! 60 INTEGER , PUBLIC :: nn_aht_ijk_t !: choice of time & space variations of the lateral eddy diffusivity coef. 61 REAL(wp), PUBLIC :: rn_aht_0 !: laplacian lateral eddy diffusivity [m2/s] 62 REAL(wp), PUBLIC :: rn_bht_0 !: bilaplacian lateral eddy diffusivity [m4/s] 63 64 ! !!* Namelist namtra_ldfeiv : eddy induced velocity param. * 65 ! != Use/diagnose eiv =! 66 LOGICAL , PUBLIC :: ln_ldfeiv !: eddy induced velocity flag 67 LOGICAL , PUBLIC :: ln_ldfeiv_dia !: diagnose & output eiv streamfunction and velocity (IOM) 68 ! != Coefficients =! 69 INTEGER , PUBLIC :: nn_aei_ijk_t !: choice of time/space variation of the eiv coeff. 70 REAL(wp), PUBLIC :: rn_aeiv_0 !: eddy induced velocity coefficient [m2/s] 71 71 72 72 LOGICAL , PUBLIC :: l_ldftra_time = .FALSE. !: flag for time variation of the lateral eddy diffusivity coef. … … 169 169 ! ! Parameter control 170 170 ! 171 IF( .NOT.ln_traldf_lap .AND. .NOT.ln_traldf_blp ) THEN 172 IF(lwp) WRITE(numout,*) ' No diffusive operator selected. ahtu and ahtv are not allocated' 173 l_ldftra_time = .FALSE. 174 RETURN 175 ENDIF 176 ! 171 177 IF( ln_traldf_blp .AND. ( ln_traldf_iso .OR. ln_traldf_triad) ) THEN ! iso-neutral bilaplacian need MSC 172 178 IF( .NOT.ln_traldf_msc ) CALL ctl_stop( 'tra_ldf_init: iso-neutral bilaplacian requires ln_traldf_msc=.true.' ) 173 179 ENDIF 174 !175 180 ! 176 181 ! Space/time variation of eddy coefficients … … 186 191 IF ( ln_traldf_lap ) THEN ; zah0 = rn_aht_0 ! laplacian operator 187 192 ELSEIF( ln_traldf_blp ) THEN ; zah0 = ABS( rn_bht_0 ) ! bilaplacian operator 188 ELSE ! NO diffusion/viscosity operator189 CALL ctl_warn( 'ldf_tra_init: No lateral diffusive operator used ' )190 193 ENDIF 191 194 ! … … 209 212 CASE ( -20 ) !== fixed horizontal shape read in file ==! 210 213 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F(i,j) read in eddy_diffusivity.nc file' 211 CALL iom_open( 'eddy_diffusivity .nc', inum )214 CALL iom_open( 'eddy_diffusivity_2D.nc', inum ) 212 215 CALL iom_get ( inum, jpdom_data, 'ahtu_2D', ahtu(:,:,1) ) 213 216 CALL iom_get ( inum, jpdom_data, 'ahtv_2D', ahtv(:,:,1) ) … … 238 241 CASE( -30 ) !== fixed 3D shape read in file ==! 239 242 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F(i,j,k) read in eddy_diffusivity.nc file' 240 CALL iom_open( 'eddy_diffusivity .nc', inum )243 CALL iom_open( 'eddy_diffusivity_3D.nc', inum ) 241 244 CALL iom_get ( inum, jpdom_data, 'ahtu_3D', ahtu ) 242 245 CALL iom_get ( inum, jpdom_data, 'ahtv_3D', ahtv ) … … 311 314 ! ! max value rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21) 312 315 ! ! increase to rn_aht_0 within 20N-20S 313 314 315 IF(lwp .AND. kt<=nit000+20 ) WRITE(numout,*) ' kt ,nn_aei_ijk_t, aeiuv max', kt, &316 & nn_aei_ijk_t, MAXVAL( aeiu(:,:,1) ), MAXVAL( aeiv(:,:,1) )317 318 319 316 IF( nn_aei_ijk_t /= 21 ) THEN 320 317 CALL ldf_eiv( kt, rn_aht_0, ahtu, ahtv ) … … 325 322 IF(lwp .AND. kt<=nit000+20 ) WRITE(numout,*) ' kt , ahtu=aeiu', kt 326 323 ENDIF 327 328 IF(lwp .AND. kt<=nit000+20 ) WRITE(numout,*) ' kt , ahtuv max ', kt, MAXVAL( ahtu(:,:,1) ), MAXVAL( ahtv(:,:,1) )329 330 324 ! 331 325 z1_f20 = 1._wp / ( 2._wp * omega * SIN( rad * 20._wp ) ) ! 1 / ff(20 degrees) 332 326 zaht_min = 0.2_wp * rn_aht_0 ! minimum value for aht 333 334 IF(lwp .AND. kt<=nit000+20 ) WRITE(numout,*) ' kt , aht0 et ahtmin', kt, rn_aht_0, zaht_min335 336 327 DO jj = 1, jpj 337 328 DO ji = 1, jpi -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r5407 r5777 4 4 !! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT 5 5 !!===================================================================== 6 !! History : 7 !! 9.0 ! 04-06 (R. Redler, NEC Laboratories Europe, Germany) Original code 8 !! " " ! 04-11 (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision 9 !! " " ! 04-11 (V. Gayler, MPI M&D) Grid writing 10 !! " " ! 05-08 (R. Redler, W. Park) frld initialization, paral(2) revision 11 !! " " ! 05-09 (R. Redler) extended to allow for communication over root only 12 !! " " ! 06-01 (W. Park) modification of physical part 13 !! " " ! 06-02 (R. Redler, W. Park) buffer array fix for root exchange 14 !! 3.4 ! 11-11 (C. Harris) Changes to allow mutiple category fields 15 !!---------------------------------------------------------------------- 6 !! History : 1.0 ! 2004-06 (R. Redler, NEC Laboratories Europe, Germany) Original code 7 !! - ! 2004-11 (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision 8 !! - ! 2004-11 (V. Gayler, MPI M&D) Grid writing 9 !! 2.0 ! 2005-08 (R. Redler, W. Park) frld initialization, paral(2) revision 10 !! - ! 2005-09 (R. Redler) extended to allow for communication over root only 11 !! - ! 2006-01 (W. Park) modification of physical part 12 !! - ! 2006-02 (R. Redler, W. Park) buffer array fix for root exchange 13 !! 3.4 ! 2011-11 (C. Harris) Changes to allow mutiple category fields 14 !! 3.6 ! 2014-11 (S. Masson) OASIS3-MCT 15 !!---------------------------------------------------------------------- 16 16 17 !!---------------------------------------------------------------------- 17 18 !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3-MCT … … 20 21 !! cpl_init : initialization of coupled mode communication 21 22 !! cpl_define : definition of grid and fields 22 !! cpl_snd : snd out fields in coupled mode23 !! cpl_rcv : receive fields in coupled mode23 !! cpl_snd : snd out fields in coupled mode 24 !! cpl_rcv : receive fields in coupled mode 24 25 !! cpl_finalize : finalize the coupled mode communication 25 26 !!---------------------------------------------------------------------- … … 99 100 !! ** Method : OASIS3 MPI communication 100 101 !!-------------------------------------------------------------------- 101 CHARACTER(len = *), INTENT(in ) :: cd_modname ! model name as set in namcouple file102 INTEGER , INTENT(out) :: kl_comm ! local communicator of the model102 CHARACTER(len = *), INTENT(in ) :: cd_modname ! model name as set in namcouple file 103 INTEGER , INTENT( out) :: kl_comm ! local communicator of the model 103 104 !!-------------------------------------------------------------------- 104 105 … … 163 164 CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld') ; RETURN 164 165 ENDIF 165 166 166 ! 167 167 ! ... Define the shape for the area that excludes the halo -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r5407 r5777 284 284 ztinta = REAL( isecsbc - sd(jf)%nrec_b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp ) 285 285 ztintb = 1. - ztinta 286 !CDIR COLLAPSE287 286 sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2) 288 287 ELSE ! nothing to do... -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r4162 r5777 195 195 196 196 DO jj = 2, jpjm1 197 !CDIR NOVERRCHK198 197 DO ji = fs_2, jpi ! vector opt. 199 198 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r5407 r5777 80 80 INTEGER , PUBLIC, PARAMETER :: jp_mfs = 6 !: MFS bulk formulation 81 81 INTEGER , PUBLIC, PARAMETER :: jp_none = 7 !: for OPA when doing coupling via SAS module 82 INTEGER , PUBLIC, PARAMETER :: jp_esopa = -1 !: esopa test, ALL formulations83 82 84 83 !!---------------------------------------------------------------------- … … 200 199 !!--------------------------------------------------------------------- 201 200 zcoef = 0.5 / ( zrhoa * zcdrag ) 202 !CDIR NOVERRCHK203 201 DO jj = 2, jpjm1 204 !CDIR NOVERRCHK205 202 DO ji = fs_2, fs_jpim1 ! vect. opt. 206 203 ztx = utau(ji-1,jj ) + utau(ji,jj) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90
r4624 r5777 279 279 ! module of wind stress and wind speed at T-point 280 280 zcoef = 1. / ( zrhoa * zcdrag ) 281 !CDIR NOVERRCHK282 281 DO jj = 2, jpjm1 283 !CDIR NOVERRCHK284 282 DO ji = fs_2, fs_jpim1 ! vect. opt. 285 283 ztx = utau(ji-1,jj ) + utau(ji,jj) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
r5215 r5777 62 62 !!--------------------------------------------------------------------- 63 63 INTEGER, INTENT(in):: kt ! ocean time step 64 ! !64 ! 65 65 INTEGER :: ierror ! local integer 66 66 INTEGER :: ios ! Local integer output status for namelist read … … 71 71 NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr, rn_pref, ln_apr_obc 72 72 !!---------------------------------------------------------------------- 73 !74 73 ! 75 74 ! ! -------------------- ! -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r5487 r5777 243 243 ! momentum fluxes (utau, vtau ) ! 244 244 !------------------------------------! 245 !CDIR COLLAPSE246 245 utau(:,:) = sf(jp_utau)%fnow(:,:,1) 247 !CDIR COLLAPSE248 246 vtau(:,:) = sf(jp_vtau)%fnow(:,:,1) 249 247 … … 251 249 ! wind stress module (taum ) ! 252 250 !------------------------------------! 253 !CDIR NOVERRCHK254 251 DO jj = 2, jpjm1 255 !CDIR NOVERRCHK256 252 DO ji = fs_2, fs_jpim1 ! vector opt. 257 253 ztx2 = utau(ji-1,jj ) + utau(ji,jj) … … 268 264 ! store the wind speed (wndm ) ! 269 265 !------------------------------------! 270 !CDIR COLLAPSE271 266 wndm(:,:) = sf(jp_wndm)%fnow(:,:,1) 272 267 wndm(:,:) = wndm(:,:) * tmask(:,:,1) … … 281 276 ! Other ocean fluxes ! 282 277 !------------------------! 283 !CDIR NOVERRCHK284 !CDIR COLLAPSE285 278 DO jj = 1, jpj 286 !CDIR NOVERRCHK287 279 DO ji = 1, jpi 288 280 ! … … 375 367 zcprec = rcp / rday ! convert prec ( mm/day ==> m/s) ==> W/m2 376 368 377 !CDIR COLLAPSE378 369 emp(:,:) = zqla(:,:) / cevap & ! freshwater flux 379 370 & - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1) 380 371 ! 381 !CDIR COLLAPSE382 372 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar flux 383 373 & - zqla(:,:) * pst(:,:) * zcevap & ! remove evap. heat content at SST in Celcius … … 415 405 416 406 # if defined key_lim2 || defined key_lim3 407 417 408 SUBROUTINE blk_ice_clio_tau 418 409 !!--------------------------------------------------------------------------- … … 429 420 ! 430 421 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio_tau') 431 422 ! 432 423 SELECT CASE( cp_ice_msh ) 433 424 ! 434 425 CASE( 'C' ) ! C-grid ice dynamics 435 426 ! 436 427 zcoef = cai / cao ! Change from air-sea stress to air-ice stress 437 428 utau_ice(:,:) = zcoef * utau(:,:) 438 429 vtau_ice(:,:) = zcoef * vtau(:,:) 439 430 ! 440 431 CASE( 'I' ) ! I-grid ice dynamics: I-point (i.e. F-point lower-left corner) 441 432 ! 442 433 zcoef = 0.5_wp * cai / cao ! Change from air-sea stress to air-ice stress 443 434 DO jj = 2, jpj ! stress from ocean U- and V-points to ice U,V point … … 447 438 END DO 448 439 END DO 449 440 ! 450 441 CALL lbc_lnk( utau_ice(:,:), 'I', -1. ) ; CALL lbc_lnk( vtau_ice(:,:), 'I', -1. ) ! I-point 451 442 ! 452 443 END SELECT 453 444 ! 454 445 IF(ln_ctl) THEN 455 446 CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_clio: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ') 456 447 ENDIF 457 448 ! 458 449 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio_tau') 459 450 ! 460 451 END SUBROUTINE blk_ice_clio_tau 452 461 453 #endif 462 454 463 455 # if defined key_lim2 || defined key_lim3 456 464 457 SUBROUTINE blk_ice_clio_flx( ptsu , palb_cs, palb_os, palb ) 465 458 !!--------------------------------------------------------------------------- … … 520 513 !-------------------------------------------------------------------------------- 521 514 522 !CDIR NOVERRCHK523 !CDIR COLLAPSE524 515 DO jj = 1, jpj 525 !CDIR NOVERRCHK526 516 DO ji = 1, jpi 527 517 ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj,1) ! air temperature in Kelvins … … 573 563 574 564 ! ! ========================== ! 575 DO jl = 1, jpl ! Loop over ice categories !565 DO jl = 1, jpl ! Loop over ice categories ! 576 566 ! ! ========================== ! 577 !CDIR NOVERRCHK578 !CDIR COLLAPSE579 567 DO jj = 1 , jpj 580 !CDIR NOVERRCHK581 568 DO ji = 1, jpi 582 569 !-------------------------------------------! … … 636 623 ! ----------------------------------------------------------------------------- ! 637 624 ! 638 !CDIR COLLAPSE639 625 qns_ice(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - qla_ice (:,:,:) ! Downward Non Solar flux 640 !CDIR COLLAPSE641 626 tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s] 642 627 ! … … 644 629 ! Correct the OCEAN non solar flux with the existence of solid precipitation ! 645 630 ! ---------------=====--------------------------------------------------------- ! 646 !CDIR COLLAPSE647 631 qns(:,:) = qns(:,:) & ! update the non-solar heat flux with: 648 632 & - sprecip(:,:) * lfus & ! remove melting solid precip … … 782 766 ! Saturated water vapour and vapour pressure 783 767 ! ------------------------------------------ 784 !CDIR NOVERRCHK785 !CDIR COLLAPSE786 768 DO jj = 1, jpj 787 !CDIR NOVERRCHK788 769 DO ji = 1, jpi 789 770 ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt … … 814 795 zdaycor = 1.0 + 0.0013 * SIN( zdist ) + 0.0342 * COS( zdist ) 815 796 816 !CDIR NOVERRCHK817 797 DO jj = 1, jpj 818 !CDIR NOVERRCHK819 798 DO ji = 1, jpi 820 799 ! product of sine (cosine) of latitude and sine (cosine) of solar declination … … 837 816 838 817 ! compute and sum ocean qsr over the daylight (i.e. between sunrise and sunset) 839 !CDIR NOVERRCHK840 818 DO jt = 1, jp24 841 819 zcoef = FLOAT( jt ) - 0.5 842 !CDIR NOVERRCHK843 !CDIR COLLAPSE844 820 DO jj = 1, jpj 845 !CDIR NOVERRCHK846 821 DO ji = 1, jpi 847 822 zlha = COS( zlsrise(ji,jj) - zcoef * zdlha(ji,jj) ) ! local hour angle … … 862 837 ! Taking into account the ellipsity of the earth orbit, the clouds AND masked if sea-ice cover > 0% 863 838 zcoef1 = srgamma * zdaycor / ( 2. * rpi ) 864 !CDIR COLLAPSE865 839 DO jj = 1, jpj 866 840 DO ji = 1, jpi … … 920 894 ! Saturated water vapour and vapour pressure 921 895 ! ------------------------------------------ 922 !CDIR NOVERRCHK923 !CDIR COLLAPSE924 896 DO jj = 1, jpj 925 !CDIR NOVERRCHK926 897 DO ji = 1, jpi 927 898 ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt … … 952 923 zdaycor = 1.0 + 0.0013 * SIN( zdist ) + 0.0342 * COS( zdist ) 953 924 954 !CDIR NOVERRCHK955 925 DO jj = 1, jpj 956 !CDIR NOVERRCHK957 926 DO ji = 1, jpi 958 927 ! product of sine (cosine) of latitude and sine (cosine) of solar declination … … 979 948 DO jl = 1, ijpl ! loop over ice categories ! 980 949 ! !----------------------------! 981 !CDIR NOVERRCHK982 950 DO jt = 1, jp24 983 951 zcoef = FLOAT( jt ) - 0.5 984 !CDIR NOVERRCHK985 !CDIR COLLAPSE986 952 DO jj = 1, jpj 987 !CDIR NOVERRCHK988 953 DO ji = 1, jpi 989 954 zlha = COS( zlsrise(ji,jj) - zcoef * zdlha(ji,jj) ) ! local hour angle -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
r5215 r5777 251 251 ! for basin budget and cooerence 252 252 !-------------------------------------------------- 253 !CDIR COLLAPSE 254 emp (:,:) = evap(:,:) - sf(jp_prec)%fnow(:,:,1) * tmask(:,:,1) 255 !CDIR COLLAPSE 253 emp(:,:) = evap(:,:) - sf(jp_prec)%fnow(:,:,1) * tmask(:,:,1) 256 254 257 255 CALL iom_put( "qlw_oce", qbw ) ! output downward longwave heat over the ocean -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5487 r5777 931 931 ! => need to be done only when otx1 was changed 932 932 IF( llnewtx ) THEN 933 !CDIR NOVERRCHK934 933 DO jj = 2, jpjm1 935 !CDIR NOVERRCHK936 934 DO ji = fs_2, fs_jpim1 ! vect. opt. 937 935 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) … … 961 959 IF( llnewtau ) THEN 962 960 zcoef = 1. / ( zrhoa * zcdrag ) 963 !CDIR NOVERRCHK964 961 DO jj = 1, jpj 965 !CDIR NOVERRCHK966 962 DO ji = 1, jpi 967 963 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
r4990 r5777 131 131 ELSE ; qsr(:,:) = sf(jp_qsr)%fnow(:,:,1) 132 132 ENDIF 133 !CDIR COLLAPSE134 133 DO jj = 1, jpj ! set the ocean fluxes from read fields 135 134 DO ji = 1, jpi … … 145 144 ! ! module of wind stress and wind speed at T-point 146 145 zcoef = 1. / ( zrhoa * zcdrag ) 147 !CDIR NOVERRCHK148 146 DO jj = 2, jpjm1 149 !CDIR NOVERRCHK150 147 DO ji = fs_2, fs_jpim1 ! vect. opt. 151 148 ztx = utau(ji-1,jj ) + utau(ji,jj) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r5721 r5777 18 18 USE eosbn2 ! equation of state 19 19 USE sbc_oce ! surface boundary condition: ocean fields 20 USE zdfbfr ! 21 ! 22 USE in_out_manager ! I/O manager 23 USE iom ! I/O manager library 24 USE fldread ! read input field at current time step 20 25 USE lbclnk ! 21 USE iom ! I/O manager library22 USE in_out_manager ! I/O manager23 26 USE wrk_nemo ! Memory allocation 24 27 USE timing ! Timing 25 28 USE lib_fortran ! glob_sum 26 USE zdfbfr27 USE fldread ! read input field at current time step28 29 30 29 31 30 IMPLICIT NONE 32 31 PRIVATE 33 32 34 PUBLIC sbc_isf, sbc_isf_div, sbc_isf_alloc ! routine called in sbcmod and div cur33 PUBLIC sbc_isf, sbc_isf_div, sbc_isf_alloc ! routine called in sbcmod and divhor 35 34 36 35 ! public in order to be able to output then … … 72 71 # include "domzgr_substitute.h90" 73 72 !!---------------------------------------------------------------------- 74 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)73 !! NEMO/OPA 3.7 , LOCEAN-IPSL (2015) 75 74 !! $Id$ 76 75 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 77 76 !!---------------------------------------------------------------------- 78 79 77 CONTAINS 80 78 81 SUBROUTINE sbc_isf(kt) 82 INTEGER, INTENT(in) :: kt ! ocean time step 83 INTEGER :: ji, jj, jk, ijkmin, inum, ierror 84 INTEGER :: ikt, ikb ! top and bottom level of the isf boundary layer 85 REAL(wp) :: rmin 86 REAL(wp) :: zhk 87 REAL(wp) :: zt_frz, zpress 88 CHARACTER(len=256) :: cfisf , cvarzisf, cvarhisf ! name for isf file 89 CHARACTER(LEN=256) :: cnameis ! name of iceshelf file 90 CHARACTER (LEN=32) :: cvarLeff ! variable name for efficient Length scale 91 INTEGER :: ios ! Local integer output status for namelist read 92 ! 79 SUBROUTINE sbc_isf(kt) 93 80 !!--------------------------------------------------------------------- 81 !! *** ROUTINE sbc_isf *** 82 !!--------------------------------------------------------------------- 83 INTEGER, INTENT(in) :: kt ! ocean time step 84 ! 85 INTEGER :: ji, jj, jk, ijkmin, inum, ierror 86 INTEGER :: ikt, ikb ! top and bottom level of the isf boundary layer 87 REAL(wp) :: rmin 88 REAL(wp) :: zhk 89 REAL(wp) :: zt_frz, zpress 90 CHARACTER(len=256) :: cfisf , cvarzisf, cvarhisf ! name for isf file 91 CHARACTER(LEN=256) :: cnameis ! name of iceshelf file 92 CHARACTER (LEN=32) :: cvarLeff ! variable name for efficient Length scale 93 INTEGER :: ios ! Local integer output status for namelist read 94 !! 94 95 NAMELIST/namsbc_isf/ nn_isfblk, rn_hisf_tbl, ln_divisf, ln_conserve, rn_gammat0, rn_gammas0, nn_gammablk, & 95 &sn_fwfisf, sn_qisf, sn_rnfisf, sn_depmax_isf, sn_depmin_isf, sn_Leff_isf96 ! 96 & sn_fwfisf, sn_qisf, sn_rnfisf, sn_depmax_isf, sn_depmin_isf, sn_Leff_isf 97 !!--------------------------------------------------------------------- 97 98 ! 98 99 ! ! ====================== ! … … 107 108 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_isf in configuration namelist', lwp ) 108 109 IF(lwm) WRITE ( numond, namsbc_isf ) 109 110 110 111 111 IF ( lwp ) WRITE(numout,*) … … 210 210 END DO 211 211 END DO 212 212 ! 213 213 END IF 214 214 … … 298 298 ! 299 299 END IF 300 300 ! 301 301 END SUBROUTINE sbc_isf 302 302 303 303 304 INTEGER FUNCTION sbc_isf_alloc() … … 320 321 END FUNCTION 321 322 322 SUBROUTINE sbc_isf_bg03(kt) 323 !!==========================================================================324 !! *** SUBROUTINE sbcisf_bg03 ***325 !! add net heat and fresh water flux from ice shelf melting326 !! into the adjacent ocean using the parameterisation by327 !! Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean328 !! interaction for climate models", Ocean Modelling 5(2003) 157-170.329 !! (hereafter BG)330 !!==========================================================================331 !!----------------------------------------------------------------------332 !! sbc_isf_bg03 : routine called from sbcmod333 !!----------------------------------------------------------------------334 !!335 !! ** Purpose : Add heat and fresh water fluxes due to ice shelf melting336 !! ** Reference : Beckmann et Goosse, 2003, Ocean Modelling337 !!338 !! History :339 !! ! 06-02 (C. Wang) Original code340 !!----------------------------------------------------------------------341 342 INTEGER, INTENT ( in ) :: kt343 323 324 SUBROUTINE sbc_isf_bg03(kt) 325 !!========================================================================== 326 !! *** SUBROUTINE sbcisf_bg03 *** 327 !! add net heat and fresh water flux from ice shelf melting 328 !! into the adjacent ocean using the parameterisation by 329 !! Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean 330 !! interaction for climate models", Ocean Modelling 5(2003) 157-170. 331 !! (hereafter BG) 332 !!========================================================================== 333 !!---------------------------------------------------------------------- 334 !! sbc_isf_bg03 : routine called from sbcmod 335 !!---------------------------------------------------------------------- 336 !! 337 !! ** Purpose : Add heat and fresh water fluxes due to ice shelf melting 338 !! ** Reference : Beckmann et Goosse, 2003, Ocean Modelling 339 !! 340 !! History : 341 !! ! 06-02 (C. Wang) Original code 342 !!---------------------------------------------------------------------- 343 INTEGER, INTENT ( in ) :: kt 344 ! 344 345 INTEGER :: ji, jj, jk, jish !temporary integer 345 346 INTEGER :: ijkmin … … 385 386 qisf(ji,jj) = 0._wp ; fwfisf(ji,jj) = 0._wp 386 387 END IF 387 END DO388 END DO388 END DO 389 END DO 389 390 ! 390 391 IF( nn_timing == 1 ) CALL timing_stop('sbc_isf_bg03') 392 ! 391 393 END SUBROUTINE sbc_isf_bg03 394 392 395 393 396 SUBROUTINE sbc_isf_cav( kt ) … … 438 441 ! 439 442 ! 440 !CDIR COLLAPSE441 443 DO jj = 1, jpj 442 444 DO ji = 1, jpi … … 492 494 493 495 ! More complicated 3 equation thermodynamics as in MITgcm 494 !CDIR COLLAPSE495 496 DO jj = 2, jpj 496 497 DO ji = 2, jpi … … 561 562 ! 562 563 IF( nn_timing == 1 ) CALL timing_stop('sbc_isf_cav') 563 564 ! 564 565 END SUBROUTINE sbc_isf_cav 566 565 567 566 568 SUBROUTINE sbc_isf_gammats(gt, gs, zqhisf, zqwisf, ji, jj, lit ) … … 689 691 END IF 690 692 END IF 691 693 ! 692 694 END SUBROUTINE 695 693 696 694 697 SUBROUTINE sbc_isf_tbl( varin, varout, cptin ) … … 752 755 IF (cptin == 'T') CALL lbc_lnk(varout,'T',1.) 753 756 IF (cptin == 'U' .OR. cptin == 'V') CALL lbc_lnk(varout,'T',-1.) 754 757 ! 755 758 END SUBROUTINE sbc_isf_tbl 756 759 … … 819 822 ! 820 823 END SUBROUTINE sbc_isf_div 821 824 825 822 826 FUNCTION tinsitu( ptem, psal, ppress ) RESULT( pti ) 823 827 !!---------------------------------------------------------------------- … … 870 874 ! 871 875 END FUNCTION tinsitu 872 ! 876 877 873 878 FUNCTION fsatg( pfps, pfpt, pfphp ) 874 879 !!---------------------------------------------------------------------- -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r5758 r5777 132 132 WRITE(numout,*) ' forced-coupled mixed formulation ln_mixcpl = ', ln_mixcpl 133 133 WRITE(numout,*) ' OASIS coupling (with atm or sas) lk_oasis = ', lk_oasis 134 WRITE(numout,*) ' components of your executable 134 WRITE(numout,*) ' components of your executable nn_components = ', nn_components 135 135 WRITE(numout,*) ' Multicategory heat flux formulation (LIM3) nn_limflx = ', nn_limflx 136 136 WRITE(numout,*) ' Misc. options of sbc : ' … … 175 175 176 176 ! ! allocate sbc arrays 177 IF( sbc_oce_alloc() /= 0 ) CALL ctl_stop( ' STOP', 'sbc_init : unable to allocate sbc_oce arrays' )177 IF( sbc_oce_alloc() /= 0 ) CALL ctl_stop( 'sbc_init : unable to allocate sbc_oce arrays' ) 178 178 179 179 ! ! Checks: 180 180 IF( nn_isf .EQ. 0 ) THEN ! variable initialisation if no ice shelf 181 IF( sbc_isf_alloc() /= 0 ) CALL ctl_stop( ' STOP', 'sbc_init : unable to allocate sbc_isf arrays' )181 IF( sbc_isf_alloc() /= 0 ) CALL ctl_stop( 'sbc_init : unable to allocate sbc_isf arrays' ) 182 182 fwfisf (:,:) = 0.0_wp ; fwfisf_b (:,:) = 0.0_wp 183 183 risf_tsc(:,:,:) = 0.0_wp ; risf_tsc_b(:,:,:) = 0.0_wp … … 223 223 ENDIF 224 224 ELSE 225 IF ( ln_cdgw .OR. ln_sdw ) &226 & CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but&227 & asked couplingwith drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ')225 IF ( ln_cdgw .OR. ln_sdw ) & 226 & CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ', & 227 & 'with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ') 228 228 ENDIF 229 229 ! ! Choice of the Surface Boudary Condition (set nsbc) … … 240 240 IF( nn_components == jp_iam_opa ) & 241 241 & THEN ; nsbc = jp_none ; icpt = icpt + 1 ; ENDIF ! opa coupling via SAS module 242 IF( lk_esopa ) nsbc = jp_esopa ! esopa test, ALL formulations 243 ! 244 IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN 245 WRITE(numout,*) 246 WRITE(numout,*) ' E R R O R in setting the sbc, one and only one namelist/CPP key option ' 247 WRITE(numout,*) ' must be choosen. You choose ', icpt, ' option(s)' 248 WRITE(numout,*) ' We stop' 249 nstop = nstop + 1 250 ENDIF 242 ! 243 IF( icpt /= 1 ) CALL ctl_stop( 'sbc_init: choose ONE and only ONE sbc option' ) 244 ! 251 245 IF(lwp) THEN 252 246 WRITE(numout,*) 253 IF( nsbc == jp_esopa ) WRITE(numout,*) ' ESOPA test All surface boundary conditions'254 247 IF( nsbc == jp_gyre ) WRITE(numout,*) ' GYRE analytical formulation' 255 248 IF( nsbc == jp_ana ) WRITE(numout,*) ' analytical formulation' … … 266 259 ! 267 260 IF( lk_oasis ) CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before: (1) first time step 268 ! 261 ! ! (2) the use of nn_fsbc 269 262 270 263 ! nn_fsbc initialization if OPA-SAS coupling via OASIS 271 264 ! sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 272 265 IF ( nn_components /= jp_iam_nemo ) THEN 273 274 266 IF ( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt) 275 267 IF ( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt) … … 367 359 IF( nn_components == jp_iam_opa ) & 368 360 CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: OPA receiving fields from SAS 369 CASE( jp_esopa )370 CALL sbc_ana ( kt ) ! ESOPA, test ALL the formulations371 CALL sbc_gyre ( kt ) !372 CALL sbc_flx ( kt ) !373 CALL sbc_blk_clio( kt ) !374 CALL sbc_blk_core( kt ) !375 CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) !376 361 END SELECT 377 362 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r5503 r5777 31 31 PRIVATE 32 32 33 PUBLIC sbc_rnf ! routine call in sbcmod module 34 PUBLIC sbc_rnf_div ! routine called in divcurl module 35 PUBLIC sbc_rnf_alloc ! routine call in sbcmod module 36 PUBLIC sbc_rnf_init ! (PUBLIC for TAM) 33 PUBLIC sbc_rnf ! routine called in sbcmod module 34 PUBLIC sbc_rnf_div ! routine called in divhor module 35 PUBLIC sbc_rnf_alloc ! routine called in sbcmod module 36 PUBLIC sbc_rnf_init ! routine called in sbcmod module 37 37 38 ! !!* namsbc_rnf namelist * 38 39 CHARACTER(len=100) :: cn_dir !: Root directory for location of rnf files -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r4990 r5777 107 107 IF( nn_sssr == 1 ) THEN !* Salinity damping term (salt flux only (sfx)) 108 108 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 109 !CDIR COLLAPSE110 109 DO jj = 1, jpj 111 110 DO ji = 1, jpi … … 121 120 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 122 121 zerp_bnd = rn_sssr_bnd / rday ! - - 123 !CDIR COLLAPSE124 122 DO jj = 1, jpj 125 123 DO ji = 1, jpi -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
r5215 r5777 4 4 !! Wave module 5 5 !!====================================================================== 6 !! History : 3.3 .1! 2011-09 (Adani M) Original code: Drag Coefficient7 !! : 3.4 6 !! History : 3.3 ! 2011-09 (Adani M) Original code: Drag Coefficient 7 !! : 3.4 ! 2012-10 (Adani M) Stokes Drift 8 8 !!---------------------------------------------------------------------- 9 USE iom ! I/O manager library 10 USE in_out_manager ! I/O manager 11 USE lib_mpp ! distribued memory computing library 9 10 !!---------------------------------------------------------------------- 11 !! sbc_wave : read drag coefficient from wave model in netcdf files 12 !!---------------------------------------------------------------------- 13 USE oce ! 14 USE sbc_oce ! Surface boundary condition: ocean fields 15 USE bdy_oce ! 16 USE domvvl ! 17 ! 18 USE iom ! I/O manager library 19 USE in_out_manager ! I/O manager 20 USE lib_mpp ! distribued memory computing library 12 21 USE fldread ! read input fields 13 USE oce 14 USE sbc_oce ! Surface boundary condition: ocean fields 15 USE domvvl 16 17 18 !!---------------------------------------------------------------------- 19 !! sbc_wave : read drag coefficient from wave model in netcdf files 20 !!---------------------------------------------------------------------- 22 USE wrk_nemo ! 21 23 22 24 IMPLICIT NONE … … 25 27 PUBLIC sbc_wave ! routine called in sbc_blk_core or sbc_blk_mfs 26 28 27 INTEGER , PARAMETER :: jpfld = 3 ! maximum number of files to read for srokes drift 28 INTEGER , PARAMETER :: jp_usd = 1 ! index of stokes drift (i-component) (m/s) at T-point 29 INTEGER , PARAMETER :: jp_vsd = 2 ! index of stokes drift (j-component) (m/s) at T-point 30 INTEGER , PARAMETER :: jp_wn = 3 ! index of wave number (1/m) at T-point 29 INTEGER , PARAMETER :: jpfld = 3 ! maximum number of files to read for srokes drift 30 INTEGER , PARAMETER :: jp_usd = 1 ! index of stokes drift (i-component) (m/s) at T-point 31 INTEGER , PARAMETER :: jp_vsd = 2 ! index of stokes drift (j-component) (m/s) at T-point 32 INTEGER , PARAMETER :: jp_wn = 3 ! index of wave number (1/m) at T-point 33 31 34 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_cd ! structure of input fields (file informations, fields read) Drag Coefficient 32 35 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sd ! structure of input fields (file informations, fields read) Stokes Drift 33 REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:) :: cdn_wave 34 REAL(wp),ALLOCATABLE,DIMENSION (:,:) :: usd2d,vsd2d,uwavenum,vwavenum 35 REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:,:) :: usd3d,vsd3d,wsd3d 36 37 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION (:,:) :: cdn_wave 38 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION (:,:,:) :: usd3d, vsd3d, wsd3d 39 REAL(wp), ALLOCATABLE, DIMENSION (:,:) :: usd2d, vsd2d, uwavenum, vwavenum 36 40 37 41 !! * Substitutions 38 42 # include "domzgr_substitute.h90" 43 # include "vectopt_loop_substitute.h90" 39 44 !!---------------------------------------------------------------------- 40 !! NEMO/OPA 4.0 , NEMO Consortium (2011)45 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 41 46 !! $Id$ 42 47 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 56 61 !! - Compute 3d stokes drift using monochromatic 57 62 !! ** action : 58 !!59 63 !!--------------------------------------------------------------------- 60 USE oce, ONLY : un,vn,hdivn,rotn 61 USE divcur 62 USE wrk_nemo 63 #if defined key_bdy 64 USE bdy_oce, ONLY : bdytmask 65 #endif 66 INTEGER, INTENT( in ) :: kt ! ocean time step 67 INTEGER :: ierror ! return error code 68 INTEGER :: ifpr, jj,ji,jk 64 INTEGER, INTENT( in ) :: kt ! ocean time step 65 ! 66 INTEGER :: ierror ! return error code 67 INTEGER :: ifpr, jj,ji,jk 69 68 INTEGER :: ios ! Local integer output status for namelist read 70 REAL(wp),DIMENSION(:,:,:),POINTER :: udummy,vdummy,hdivdummy,rotdummy71 REAL :: z2dt,z1_2dt72 69 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist informations on the fields to read 73 70 CHARACTER(len=100) :: cn_dir ! Root directory for location of drag coefficient files 74 71 TYPE(FLD_N) :: sn_cdg, sn_usd, sn_vsd, sn_wn ! informations about the fields to be read 75 !!--------------------------------------------------------------------- 72 REAL(wp), DIMENSION(:,:,:), POINTER :: zusd_t, zvsd_t, ze3hdiv ! 3D workspace 73 !! 76 74 NAMELIST/namsbc_wave/ sn_cdg, cn_dir, sn_usd, sn_vsd, sn_wn 77 75 !!--------------------------------------------------------------------- 78 79 !!----------------------------------------------------------------------80 !81 76 ! 82 77 ! ! -------------------- ! … … 92 87 IF(lwm) WRITE ( numond, namsbc_wave ) 93 88 ! 94 95 89 IF ( ln_cdgw ) THEN 96 90 ALLOCATE( sf_cd(1), STAT=ierror ) !* allocate and fill sf_wave with sn_cdg … … 102 96 ALLOCATE( cdn_wave(jpi,jpj) ) 103 97 cdn_wave(:,:) = 0.0 104 ENDIF98 ENDIF 105 99 IF ( ln_sdw ) THEN 106 100 slf_i(jp_usd) = sn_usd ; slf_i(jp_vsd) = sn_vsd; slf_i(jp_wn) = sn_wn … … 113 107 END DO 114 108 CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' ) 115 ALLOCATE( usd2d(jpi,jpj) ,vsd2d(jpi,jpj),uwavenum(jpi,jpj),vwavenum(jpi,jpj) )109 ALLOCATE( usd2d(jpi,jpj) , vsd2d(jpi,jpj) , uwavenum(jpi,jpj) , vwavenum(jpi,jpj) ) 116 110 ALLOCATE( usd3d(jpi,jpj,jpk),vsd3d(jpi,jpj,jpk),wsd3d(jpi,jpj,jpk) ) 117 usd2d(:,:) = 0.0 ; vsd2d(:,:) = 0.0 ; uwavenum(:,:) = 0.0 ; vwavenum(:,:) = 0.0 118 usd3d(:,:,:) = 0.0 ;vsd3d(:,:,:) = 0.0 ; wsd3d(:,:,:) = 0.0 111 usd3d(:,:,:) = 0._wp ; usd2d(:,:) = 0._wp ; uwavenum(:,:) = 0._wp 112 vsd3d(:,:,:) = 0._wp ; vsd2d(:,:) = 0._wp ; vwavenum(:,:) = 0._wp 113 wsd3d(:,:,:) = 0._wp 119 114 ENDIF 120 115 ENDIF 116 ! 117 IF ( ln_cdgw ) THEN !== Neutral drag coefficient ==! 118 CALL fld_read( kt, nn_fsbc, sf_cd ) ! read from external forcing 119 cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1) 120 ENDIF 121 ! 122 IF ( ln_sdw ) THEN !== Computation of the 3d Stokes Drift ==! 123 ! 124 CALL fld_read( kt, nn_fsbc, sf_sd ) !* read drag coefficient from external forcing 121 125 ! 122 126 ! 123 IF ( ln_cdgw ) THEN 124 CALL fld_read( kt, nn_fsbc, sf_cd ) !* read drag coefficient from external forcing 125 cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1) 126 ENDIF 127 IF ( ln_sdw ) THEN 128 CALL fld_read( kt, nn_fsbc, sf_sd ) !* read drag coefficient from external forcing 129 130 ! Interpolate wavenumber, stokes drift into the grid_V and grid_V 131 !------------------------------------------------- 132 133 DO jj = 1, jpjm1 134 DO ji = 1, jpim1 135 uwavenum(ji,jj)=0.5 * ( 2. - umask(ji,jj,1) ) * ( sf_sd(3)%fnow(ji,jj,1) * tmask(ji,jj,1) & 136 & + sf_sd(3)%fnow(ji+1,jj,1) * tmask(ji+1,jj,1) ) 137 138 vwavenum(ji,jj)=0.5 * ( 2. - vmask(ji,jj,1) ) * ( sf_sd(3)%fnow(ji,jj,1) * tmask(ji,jj,1) & 139 & + sf_sd(3)%fnow(ji,jj+1,1) * tmask(ji,jj+1,1) ) 140 141 usd2d(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( sf_sd(1)%fnow(ji,jj,1) * tmask(ji,jj,1) & 142 & + sf_sd(1)%fnow(ji+1,jj,1) * tmask(ji+1,jj,1) ) 143 144 vsd2d(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( sf_sd(2)%fnow(ji,jj,1) * tmask(ji,jj,1) & 145 & + sf_sd(2)%fnow(ji,jj+1,1) * tmask(ji,jj+1,1) ) 127 CALL wrk_alloc( jpi,jpj,jpk, zusd_t, zvsd_t, ze3hdiv ) 128 ! !* distribute it on the vertical 129 DO jk = 1, jpkm1 130 zusd_t(:,:,jk) = sf_sd(jp_usd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * fsdept_n(:,:,jk) ) 131 zvsd_t(:,:,jk) = sf_sd(jp_vsd)%fnow(:,:,1) * EXP( -2._wp * sf_sd(jp_wn)%fnow(:,:,1) * fsdept_n(:,:,jk) ) 132 END DO 133 ! !* interpolate the stokes drift from t-point to u- and v-points 134 DO jk = 1, jpkm1 135 DO jj = 1, jpjm1 136 DO ji = 1, jpim1 137 usd3d(ji,jj,jk) = 0.5_wp * ( zusd_t(ji ,jj,jk) + zusd_t(ji+1,jj,jk) ) * umask(ji,jj,jk) 138 vsd3d(ji,jj,jk) = 0.5_wp * ( zvsd_t(ji ,jj,jk) + zvsd_t(ji+1,jj,jk) ) * vmask(ji,jj,jk) 139 END DO 146 140 END DO 147 141 END DO 148 149 !Computation of the 3d Stokes Drift 150 DO jk = 1, jpk 151 DO jj = 1, jpj-1 152 DO ji = 1, jpi-1 153 usd3d(ji,jj,jk) = usd2d(ji,jj)*exp(2.0*uwavenum(ji,jj)*(-MIN( gdept_0(ji,jj,jk) , gdept_0(ji+1,jj ,jk)))) 154 vsd3d(ji,jj,jk) = vsd2d(ji,jj)*exp(2.0*vwavenum(ji,jj)*(-MIN( gdept_0(ji,jj,jk) , gdept_0(ji ,jj+1,jk)))) 155 END DO 156 END DO 157 usd3d(jpi,:,jk) = usd2d(jpi,:)*exp( 2.0*uwavenum(jpi,:)*(-gdept_0(jpi,:,jk)) ) 158 vsd3d(:,jpj,jk) = vsd2d(:,jpj)*exp( 2.0*vwavenum(:,jpj)*(-gdept_0(:,jpj,jk)) ) 159 END DO 160 161 CALL wrk_alloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy,rotdummy) 162 163 udummy(:,:,:)=un(:,:,:) 164 vdummy(:,:,:)=vn(:,:,:) 165 hdivdummy(:,:,:)=hdivn(:,:,:) 166 rotdummy(:,:,:)=rotn(:,:,:) 167 un(:,:,:)=usd3d(:,:,:) 168 vn(:,:,:)=vsd3d(:,:,:) 169 CALL div_cur(kt) 170 ! !------------------------------! 171 ! ! Now Vertical Velocity ! 172 ! !------------------------------! 173 z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog) 174 175 z1_2dt = 1.e0 / z2dt 176 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 177 ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise 178 wsd3d(:,:,jk) = wsd3d(:,:,jk+1) - fse3t_n(:,:,jk) * hdivn(:,:,jk) & 179 & - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) ) & 180 & * tmask(:,:,jk) * z1_2dt 142 CALL lbc_lnk( usd3d(:,:,:), 'U', -1. ) 143 CALL lbc_lnk( vsd3d(:,:,:), 'V', -1. ) 144 ! 145 DO jk = 1, jpkm1 !* e3t * Horizontal divergence ==! 146 DO jj = 2, jpjm1 147 DO ji = fs_2, fs_jpim1 ! vector opt. 148 ze3hdiv(ji,jj,jk) = ( e2u(ji ,jj) * fse3u_n(ji ,jj,jk) * usd3d(ji ,jj,jk) & 149 & - e2u(ji-1,jj) * fse3u_n(ji-1,jj,jk) * usd3d(ji-1,jj,jk) & 150 & + e1v(ji,jj ) * fse3v_n(ji,jj ,jk) * vsd3d(ji,jj ,jk) & 151 & - e1v(ji,jj-1) * fse3v_n(ji,jj-1,jk) * vsd3d(ji,jj-1,jk) ) * r1_e1e2t(ji,jj) 152 END DO 153 END DO 154 IF( .NOT. AGRIF_Root() ) THEN 155 IF( nbondi == 1 .OR. nbondi == 2 ) ze3hdiv(nlci-1, : ,jk) = 0._wp ! east 156 IF( nbondi == -1 .OR. nbondi == 2 ) ze3hdiv( 2 , : ,jk) = 0._wp ! west 157 IF( nbondj == 1 .OR. nbondj == 2 ) ze3hdiv( : ,nlcj-1,jk) = 0._wp ! north 158 IF( nbondj == -1 .OR. nbondj == 2 ) ze3hdiv( : , 2 ,jk) = 0._wp ! south 159 ENDIF 160 END DO 161 CALL lbc_lnk( ze3hdiv, 'T', 1. ) 162 ! 163 DO jk = jpkm1, 1, -1 !* integrate from the bottom the e3t * hor. divergence 164 wsd3d(:,:,jk) = wsd3d(:,:,jk+1) - ze3hdiv(:,:,jk) 165 END DO 181 166 #if defined key_bdy 182 wsd3d(:,:,jk) = wsd3d(:,:,jk) * bdytmask(:,:) 167 IF( lk_bdy ) THEN 168 DO jk = 1, jpkm1 169 wsd3d(:,:,jk) = wsd3d(:,:,jk) * bdytmask(:,:) 170 END DO 171 ENDIF 183 172 #endif 184 END DO 185 hdivn(:,:,:)=hdivdummy(:,:,:) 186 rotn(:,:,:)=rotdummy(:,:,:) 187 vn(:,:,:)=vdummy(:,:,:) 188 un(:,:,:)=udummy(:,:,:) 189 CALL wrk_dealloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy,rotdummy) 173 CALL wrk_dealloc( jpi,jpj,jpk, zusd_t, zvsd_t, ze3hdiv ) 174 ! 190 175 ENDIF 176 ! 191 177 END SUBROUTINE sbc_wave 192 178 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90
r5537 r5777 11 11 !! 3.2 ! 2009-07 (R. Benshila) suppression of rigid-lid & FETI solver 12 12 !!---------------------------------------------------------------------- 13 #if defined key_dynspg_flt || defined key_esopa13 #if defined key_dynspg_flt 14 14 !!---------------------------------------------------------------------- 15 15 !! 'key_dynspg_flt' filtered free surface -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r5737 r5777 14 14 !! - ! 2013-04 (F. Roquet, G. Madec) use of eosbn2 instead of local hard coded alpha and beta 15 15 !!---------------------------------------------------------------------- 16 #if defined key_trabbl || defined key_esopa16 #if defined key_trabbl 17 17 !!---------------------------------------------------------------------- 18 18 !! 'key_trabbl' or bottom boundary layer -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r5770 r5777 40 40 PUBLIC tra_ldf_init ! called by nemogcm.F90 41 41 ! 42 INTEGER :: nldf = 0 ! type of lateral diffusion used defined from ln_traldf_... namlist logicals)42 INTEGER :: nldf = 0 ! type of lateral diffusion used defined from ln_traldf_... (namlist logicals) 43 43 44 44 !! * Substitutions … … 75 75 CASE ( np_lap ) ! laplacian: iso-level operator 76 76 CALL tra_ldf_lap ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsa, jpts, 1 ) 77 !78 77 CASE ( np_lap_i ) ! laplacian: standard iso-neutral operator (Madec) 79 78 CALL tra_ldf_iso ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts, 1 ) 80 !81 79 CASE ( np_lap_it ) ! laplacian: triad iso-neutral operator (griffies) 82 80 CALL tra_ldf_triad( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts, 1 ) 83 !84 81 CASE ( np_blp , np_blp_i , np_blp_it ) ! bilaplacian: iso-level & iso-neutral operators 85 82 CALL tra_ldf_blp ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb , tsa, jpts, nldf ) … … 121 118 WRITE(numout,*) 122 119 ENDIF 123 ! ! control the input 120 ! ! use of lateral operator or not 121 nldf = np_ERROR 124 122 ioptio = 0 125 123 IF( ln_traldf_lap ) ioptio = ioptio + 1 … … 127 125 IF( ioptio > 1 ) CALL ctl_stop( 'tra_ldf_init: use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 128 126 IF( ioptio == 0 ) nldf = np_no_ldf ! No lateral diffusion 129 ioptio = 0 130 IF( ln_traldf_lev ) ioptio = ioptio + 1 131 IF( ln_traldf_hor ) ioptio = ioptio + 1 132 IF( ln_traldf_iso ) ioptio = ioptio + 1 133 IF( ioptio > 1 ) CALL ctl_stop( 'tra_ldf_init: use only ONE direction (level/hor/iso)' ) 134 ! 135 ! ! defined the type of lateral diffusion from ln_traldf_... logicals 136 ierr = 0 137 IF( ln_traldf_lap ) THEN ! laplacian operator 138 IF ( ln_zco ) THEN ! z-coordinate 139 IF ( ln_traldf_lev ) nldf = np_lap ! iso-level = horizontal (no rotation) 140 IF ( ln_traldf_hor ) nldf = np_lap ! iso-level = horizontal (no rotation) 141 IF ( ln_traldf_iso ) nldf = np_lap_i ! iso-neutral: standard ( rotation) 142 IF ( ln_traldf_triad ) nldf = np_lap_it ! iso-neutral: triad ( rotation) 127 ! 128 IF( nldf /= np_no_ldf ) THEN ! direction ==>> type of operator 129 ioptio = 0 130 IF( ln_traldf_lev ) ioptio = ioptio + 1 131 IF( ln_traldf_hor ) ioptio = ioptio + 1 132 IF( ln_traldf_iso ) ioptio = ioptio + 1 133 IF( ioptio > 1 ) CALL ctl_stop( 'tra_ldf_init: use only ONE direction (level/hor/iso)' ) 134 ! 135 ! ! defined the type of lateral diffusion from ln_traldf_... logicals 136 ierr = 0 137 IF( ln_traldf_lap ) THEN ! laplacian operator 138 IF ( ln_zco ) THEN ! z-coordinate 139 IF ( ln_traldf_lev ) nldf = np_lap ! iso-level = horizontal (no rotation) 140 IF ( ln_traldf_hor ) nldf = np_lap ! iso-level = horizontal (no rotation) 141 IF ( ln_traldf_iso ) nldf = np_lap_i ! iso-neutral: standard ( rotation) 142 IF ( ln_traldf_triad ) nldf = np_lap_it ! iso-neutral: triad ( rotation) 143 ENDIF 144 IF ( ln_zps ) THEN ! z-coordinate with partial step 145 IF ( ln_traldf_lev ) ierr = 1 ! iso-level not allowed 146 IF ( ln_traldf_hor ) nldf = np_lap ! horizontal (no rotation) 147 IF ( ln_traldf_iso ) nldf = np_lap_i ! iso-neutral: standard (rotation) 148 IF ( ln_traldf_triad ) nldf = np_lap_it ! iso-neutral: triad (rotation) 149 ENDIF 150 IF ( ln_sco ) THEN ! s-coordinate 151 IF ( ln_traldf_lev ) nldf = np_lap ! iso-level (no rotation) 152 IF ( ln_traldf_hor ) nldf = np_lap_i ! horizontal ( rotation) 153 IF ( ln_traldf_iso ) nldf = np_lap_i ! iso-neutral: standard ( rotation) 154 IF ( ln_traldf_triad ) nldf = np_lap_it ! iso-neutral: triad ( rotation) 155 ENDIF 143 156 ENDIF 144 IF ( ln_zps ) THEN ! z-coordinate with partial step 145 IF ( ln_traldf_lev ) ierr = 1 ! iso-level not allowed 146 IF ( ln_traldf_hor ) nldf = np_lap ! horizontal (no rotation) 147 IF ( ln_traldf_iso ) nldf = np_lap_i ! iso-neutral: standard (rotation) 148 IF ( ln_traldf_triad ) nldf = np_lap_it ! iso-neutral: triad (rotation) 149 ENDIF 150 IF ( ln_sco ) THEN ! s-coordinate 151 IF ( ln_traldf_lev ) nldf = np_lap ! iso-level (no rotation) 152 IF ( ln_traldf_hor ) nldf = np_lap_i ! horizontal ( rotation) 153 IF ( ln_traldf_iso ) nldf = np_lap_i ! iso-neutral: standard ( rotation) 154 IF ( ln_traldf_triad ) nldf = np_lap_it ! iso-neutral: triad ( rotation) 155 ENDIF 156 ENDIF 157 ! 158 IF( ln_traldf_blp ) THEN ! bilaplacian operator 159 IF ( ln_zco ) THEN ! z-coordinate 160 IF ( ln_traldf_lev ) nldf = np_blp ! iso-level = horizontal (no rotation) 161 IF ( ln_traldf_hor ) nldf = np_blp ! iso-level = horizontal (no rotation) 162 IF ( ln_traldf_iso ) nldf = np_blp_i ! iso-neutral: standard ( rotation) 163 IF ( ln_traldf_triad ) nldf = np_blp_it ! iso-neutral: triad ( rotation) 164 ENDIF 165 IF ( ln_zps ) THEN ! z-coordinate with partial step 166 IF ( ln_traldf_lev ) ierr = 1 ! iso-level not allowed 167 IF ( ln_traldf_hor ) nldf = np_blp ! horizontal (no rotation) 168 IF ( ln_traldf_iso ) nldf = np_blp_i ! iso-neutral: standard ( rotation) 169 IF ( ln_traldf_triad ) nldf = np_blp_it ! iso-neutral: triad ( rotation) 170 ENDIF 171 IF ( ln_sco ) THEN ! s-coordinate 172 IF ( ln_traldf_lev ) nldf = np_blp ! iso-level (no rotation) 173 IF ( ln_traldf_hor ) nldf = np_blp_it ! horizontal ( rotation) 174 IF ( ln_traldf_iso ) nldf = np_blp_i ! iso-neutral: standard ( rotation) 175 IF ( ln_traldf_triad ) nldf = np_blp_it ! iso-neutral: triad ( rotation) 157 ! 158 IF( ln_traldf_blp ) THEN ! bilaplacian operator 159 IF ( ln_zco ) THEN ! z-coordinate 160 IF ( ln_traldf_lev ) nldf = np_blp ! iso-level = horizontal (no rotation) 161 IF ( ln_traldf_hor ) nldf = np_blp ! iso-level = horizontal (no rotation) 162 IF ( ln_traldf_iso ) nldf = np_blp_i ! iso-neutral: standard ( rotation) 163 IF ( ln_traldf_triad ) nldf = np_blp_it ! iso-neutral: triad ( rotation) 164 ENDIF 165 IF ( ln_zps ) THEN ! z-coordinate with partial step 166 IF ( ln_traldf_lev ) ierr = 1 ! iso-level not allowed 167 IF ( ln_traldf_hor ) nldf = np_blp ! horizontal (no rotation) 168 IF ( ln_traldf_iso ) nldf = np_blp_i ! iso-neutral: standard ( rotation) 169 IF ( ln_traldf_triad ) nldf = np_blp_it ! iso-neutral: triad ( rotation) 170 ENDIF 171 IF ( ln_sco ) THEN ! s-coordinate 172 IF ( ln_traldf_lev ) nldf = np_blp ! iso-level (no rotation) 173 IF ( ln_traldf_hor ) nldf = np_blp_it ! horizontal ( rotation) 174 IF ( ln_traldf_iso ) nldf = np_blp_i ! iso-neutral: standard ( rotation) 175 IF ( ln_traldf_triad ) nldf = np_blp_it ! iso-neutral: triad ( rotation) 176 ENDIF 176 177 ENDIF 177 178 ENDIF -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_blp.F90
r5770 r5777 36 36 37 37 ! ! Flag to control the type of lateral diffusive operator 38 INTEGER, PARAMETER, PUBLIC :: np_ERROR =-10 ! error in specification of lateral diffusion 38 39 INTEGER, PARAMETER, PUBLIC :: np_no_ldf = 00 ! without operator (i.e. no lateral diffusive trend) 39 40 ! !! laplacian ! bilaplacian ! -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90
r5758 r5777 74 74 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 75 75 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 76 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu , pgv! tracer gradient at pstep levels76 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu , pgv ! tracer gradient at pstep levels 77 77 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 78 78 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! tracer (kpass=1) or laplacian of tracer (kpass=2) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r5407 r5777 189 189 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 190 190 ! 191 !CDIR COLLAPSE192 !CDIR NOVERRCHK193 191 DO jj = 1, jpj ! Separation in R-G-B depending of the surface Chl 194 !CDIR NOVERRCHK195 192 DO ji = 1, jpi 196 193 zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) … … 217 214 ! 218 215 DO jk = 2, nksr+1 219 !CDIR NOVERRCHK220 216 DO jj = 1, jpj 221 !CDIR NOVERRCHK222 217 DO ji = 1, jpi 223 218 zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r ) … … 495 490 496 491 DO jk = 2, nksr+1 497 !CDIR NOVERRCHK498 492 DO jj = 1, jpj 499 !CDIR NOVERRCHK500 493 DO ji = 1, jpi 501 494 zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * xsi0r ) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90
r5758 r5777 4 4 !! Ocean diagnostics: global domain averaged tracer and momentum trends 5 5 !!===================================================================== 6 !! History : 1.0 ! 2004-08 (C. Talandier) New trends organization7 !! 3.5 ! 2012-02 (G. Madec) add 3D tracer zdf trend output using iom6 !! History : 1.0 ! 2004-08 (C. Talandier) New trends organization 7 !! 3.5 ! 2012-02 (G. Madec) add 3D tracer zdf trend output using iom 8 8 !!---------------------------------------------------------------------- 9 9 … … 19 19 USE trd_oce ! trends: ocean variables 20 20 USE phycst ! physical constants 21 USE ldftra ! ocean active tracers: lateral physics22 USE ldfdyn _oce! ocean dynamics: lateral physics21 USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff. 22 USE ldfdyn ! ocean dynamics: lateral physics 23 23 USE zdf_oce ! ocean vertical physics 24 24 USE zdfbfr ! bottom friction … … 26 26 USE eosbn2 ! equation of state 27 27 USE phycst ! physical constants 28 ! 28 29 USE lib_mpp ! distibuted memory computing library 29 30 USE in_out_manager ! I/O manager -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r5758 r5777 13 13 USE oce ! ocean dynamics and tracers variables 14 14 USE dom_oce ! ocean space and time domain variables 15 USE sbc_oce ! surface boundary condition: ocean 15 16 USE zdf_oce ! ocean vertical physics variables 16 17 USE trd_oce ! trends: ocean variables … … 18 19 USE zdfbfr ! bottom friction 19 20 USE ldftra ! ocean active tracers lateral physics 20 USE sbc_oce ! surface boundary condition: ocean21 21 USE phycst ! physical constants 22 22 USE trdvor ! ocean vorticity trends 23 23 USE trdglo ! trends:global domain averaged 24 USE trdmxl ! ocean active mixed layer tracers trends 24 USE trdmxl ! ocean active mixed layer tracers trends 25 ! 25 26 USE in_out_manager ! I/O manager 26 27 USE iom ! I/O manager library -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90
r5770 r5777 24 24 USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff. 25 25 USE zdf_oce ! ocean vertical physics 26 USE in_out_manager ! I/O manager27 26 USE phycst ! Define parameters for the routines 28 27 USE dianam ! build the name of file (routine) … … 30 29 USE zdfmxl ! mixed layer depth 31 30 USE zdfddm ! ocean vertical physics: double diffusion 32 USE ioipsl ! NetCDF library33 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 34 32 USE diadimg ! dimg direct access file format output 35 33 USE trdmxl_rst ! restart for diagnosing the ML trends 34 ! 35 USE in_out_manager ! I/O manager 36 USE ioipsl ! NetCDF library 36 37 USE prtctl ! Print control 37 38 USE restart ! for lrst_oce -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
r5758 r5777 17 17 USE trd_oce ! trends: ocean variables 18 18 USE eosbn2 ! equation of state and related derivatives 19 USE ldftra ! ocean active tracers lateral physics19 USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff. 20 20 USE zdfddm ! vertical physics: double diffusion 21 21 USE phycst ! physical constants 22 ! 22 23 USE in_out_manager ! I/O manager 23 24 USE iom ! I/O manager library … … 99 100 CALL wrk_alloc( jpi, jpj, z2d ) 100 101 z2d(:,:) = wn(:,:,1) * ( & 101 & - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem) &102 & + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal) &103 &) / fse3t(:,:,1)102 & - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem) & 103 & + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal) & 104 & ) / fse3t(:,:,1) 104 105 CALL iom_put( "petrd_sad" , z2d ) 105 106 CALL wrk_dealloc( jpi, jpj, z2d ) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
r4990 r5777 20 20 USE sbc_oce ! surface boundary condition: ocean 21 21 USE phycst ! Define parameters for the routines 22 USE ldfdyn _oce! ocean active tracers: lateral physics22 USE ldfdyn ! ocean active tracers: lateral physics 23 23 USE dianam ! build the name of file (routine) 24 24 USE zdfmxl ! mixed layer depth 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link)25 ! 26 26 USE in_out_manager ! I/O manager 27 27 USE ioipsl ! NetCDF library 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 28 29 USE lib_mpp ! MPP library 29 30 USE wrk_nemo ! Memory allocation … … 57 58 !! * Substitutions 58 59 # include "domzgr_substitute.h90" 59 # include "ldfdyn_substitute.h90"60 60 # include "vectopt_loop_substitute.h90" 61 61 !!---------------------------------------------------------------------- -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
r5656 r5777 16 16 PUBLIC zdf_oce_alloc ! Called in nemogcm.F90 17 17 18 #if defined key_zdfcst || defined key_esopa18 #if defined key_zdfcst 19 19 LOGICAL, PARAMETER, PUBLIC :: lk_zdfcst = .TRUE. !: constant vertical mixing flag 20 20 #else … … 45 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k , avm_k ! not enhanced Kz 46 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k, avmv_k ! not enhanced Kz 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy [m2/s2]48 47 49 48 !!---------------------------------------------------------------------- … … 65 64 & avmv (jpi,jpj,jpk), avt (jpi,jpj,jpk), & 66 65 & avt_k (jpi,jpj,jpk), avm_k (jpi,jpj,jpk), & 67 & avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk), & 68 & en (jpi,jpj,jpk), STAT = zdf_oce_alloc ) 66 & avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk), STAT = zdf_oce_alloc ) 69 67 ! 70 68 IF( zdf_oce_alloc /= 0 ) CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays') -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
r5120 r5777 9 9 !! 3.6 ! 2013-04 (G. Madec, F. Roquet) zrau compute locally using interpolation of alpha & beta 10 10 !!---------------------------------------------------------------------- 11 #if defined key_zdfddm || defined key_esopa11 #if defined key_zdfddm 12 12 !!---------------------------------------------------------------------- 13 13 !! 'key_zdfddm' : double diffusion … … 162 162 ! ------------------ 163 163 ! Constant eddy coefficient: reset to the background value 164 !CDIR NOVERRCHK165 164 DO jj = 1, jpj 166 !CDIR NOVERRCHK167 165 DO ji = 1, jpi 168 166 zinr = 1._wp / zrau(ji,jj) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r5656 r5777 8 8 !! 3.3 ! 2010-10 (C. Bricaud) Add in the reference 9 9 !!---------------------------------------------------------------------- 10 #if defined key_zdfgls || defined key_esopa10 #if defined key_zdfgls 11 11 !!---------------------------------------------------------------------- 12 12 !! 'key_zdfgls' Generic Length Scale vertical physics … … 42 42 LOGICAL , PUBLIC, PARAMETER :: lk_zdfgls = .TRUE. !: TKE vertical mixing flag 43 43 ! 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy 44 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mxln !: now mixing length 45 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zwall !: wall function … … 115 116 !! *** FUNCTION zdf_gls_alloc *** 116 117 !!---------------------------------------------------------------------- 117 ALLOCATE( mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) , &118 ALLOCATE( en(jpi,jpj,jpk), mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) , & 118 119 & ustars2(jpi,jpj), ustarb2(jpi,jpj) , STAT= zdf_gls_alloc ) 119 120 ! … … 154 155 IF( nn_timing == 1 ) CALL timing_start('zdf_gls') 155 156 ! 156 CALL wrk_alloc( jpi,jpj, zdep, zkar, zflxs, zhsro )157 CALL wrk_alloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )157 CALL wrk_alloc( jpi,jpj, zdep, zkar, zflxs, zhsro ) 158 CALL wrk_alloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi ) 158 159 159 160 ! Preliminary computing … … 169 170 170 171 ! Compute surface and bottom friction at T-points 171 !CDIR NOVERRCHK172 172 DO jj = 2, jpjm1 173 !CDIR NOVERRCHK174 173 DO ji = fs_2, fs_jpim1 ! vector opt. 175 174 ! … … 360 359 ! ! en(ibot) = u*^2 / Co2 and mxln(ibot) = rn_lmin 361 360 ! ! Balance between the production and the dissipation terms 362 !CDIR NOVERRCHK 363 DO jj = 2, jpjm1 364 !CDIR NOVERRCHK 361 DO jj = 2, jpjm1 365 362 DO ji = fs_2, fs_jpim1 ! vector opt. 366 363 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point … … 383 380 CASE ( 1 ) ! Neumman boundary condition 384 381 ! 385 !CDIR NOVERRCHK 386 DO jj = 2, jpjm1 387 !CDIR NOVERRCHK 382 DO jj = 2, jpjm1 388 383 DO ji = fs_2, fs_jpim1 ! vector opt. 389 384 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point … … 588 583 ! ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * rn_bfrz0 589 584 ! ! Balance between the production and the dissipation terms 590 !CDIR NOVERRCHK 591 DO jj = 2, jpjm1 592 !CDIR NOVERRCHK 585 DO jj = 2, jpjm1 593 586 DO ji = fs_2, fs_jpim1 ! vector opt. 594 587 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point … … 611 604 CASE ( 1 ) ! Neumman boundary condition 612 605 ! 613 !CDIR NOVERRCHK 614 DO jj = 2, jpjm1 615 !CDIR NOVERRCHK 606 DO jj = 2, jpjm1 616 607 DO ji = fs_2, fs_jpim1 ! vector opt. 617 608 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point … … 834 825 avmv_k(:,:,:) = avmv(:,:,:) 835 826 ! 836 CALL wrk_dealloc( jpi,jpj, zdep, zkar, zflxs, zhsro )837 CALL wrk_dealloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )827 CALL wrk_dealloc( jpi,jpj, zdep, zkar, zflxs, zhsro ) 828 CALL wrk_dealloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi ) 838 829 ! 839 830 IF( nn_timing == 1 ) CALL timing_stop('zdf_gls') -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
r5758 r5777 6 6 !! History : 8.0 ! 1997-06 (G. Madec) Original code from inimix 7 7 !! 1.0 ! 2002-08 (G. Madec) F90 : free form 8 !! - ! 2005-06 (C. Ethe) KPP scheme 8 9 !! - ! 2009-07 (G. Madec) add avmb, avtb in restart for cen2 advection 10 !! 3.7 ! 2014-12 (G. Madec) remove KPP scheme 9 11 !!---------------------------------------------------------------------- 10 12 … … 13 15 !!---------------------------------------------------------------------- 14 16 USE par_oce ! mesh and scale factors 15 !!gm USE ldftra ! ocean active tracers: lateral physics16 !!gm USE ldfdyn_oce ! ocean dynamics lateral physics17 17 USE zdf_oce ! TKE vertical mixing 18 USE lib_mpp ! distribued memory computing18 USE sbc_oce ! surface module (only for nn_isf in the option compatibility test) 19 19 USE zdftke ! TKE vertical mixing 20 20 USE zdfgls ! GLS vertical mixing 21 USE zdfric ! Richardson vertical mixing 21 22 USE zdfddm ! double diffusion mixing 22 23 USE zdfevd ! enhanced vertical diffusion 23 USE zdfric ! Richardson vertical mixing24 24 USE tranpc ! convection: non penetrative adjustment 25 25 USE ldfslp ! iso-neutral slopes 26 26 ! 27 27 USE in_out_manager ! I/O manager 28 28 USE iom ! IOM library 29 USE lib_mpp ! distribued memory computing 29 30 30 31 IMPLICIT NONE … … 48 49 !! ** Method : Read namelist namzdf, control logicals 49 50 !!---------------------------------------------------------------------- 50 INTEGER :: ioptio ! temporary scalar 51 INTEGER :: ios 51 INTEGER :: ioptio, ios ! local integers 52 52 !! 53 53 NAMELIST/namzdf/ rn_avm0, rn_avt0, nn_avb, nn_havtb, ln_zdfexp, nn_zdfexp, & … … 109 109 ioptio = ioptio+1 110 110 ENDIF 111 IF( ioptio == 0 .OR. ioptio > 1 .AND. .NOT. lk_esopa) &111 IF( ioptio == 0 .OR. ioptio > 1 ) & 112 112 & CALL ctl_stop( ' one and only one vertical diffusion option has to be defined ' ) 113 113 IF( ( lk_zdfric .OR. lk_zdfgls ) .AND. ln_isfcav ) & … … 137 137 IF(lwp) WRITE(numout,*) ' use the GLS closure scheme' 138 138 ENDIF 139 IF ( ioptio > 1 .AND. .NOT. lk_esopa) CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' )139 IF ( ioptio > 1 ) CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' ) 140 140 IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls ) ) & 141 141 CALL ctl_stop( ' except for TKE or GLS physics, a convection scheme is', & -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r4624 r5777 13 13 !! 3.3.1! 2011-09 (P. Oddo) Mixed layer depth parameterization 14 14 !!---------------------------------------------------------------------- 15 #if defined key_zdfric || defined key_esopa15 #if defined key_zdfric 16 16 !!---------------------------------------------------------------------- 17 17 !! 'key_zdfric' Kz = f(Ri) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r5656 r5777 28 28 !! 3.6 ! 2014-11 (P. Mathiot) add ice shelf capability 29 29 !!---------------------------------------------------------------------- 30 #if defined key_zdftke || defined key_esopa30 #if defined key_zdftke 31 31 !!---------------------------------------------------------------------- 32 32 !! 'key_zdftke' TKE vertical physics … … 89 89 REAL(wp) :: rhftau_scl = 1.0_wp ! scale factor applied to HF part of taum (nn_etau=3) 90 90 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy [m2/s2] 91 92 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: htau ! depth of tke penetration (nn_htau) 92 93 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dissl ! now mixing lenght of dissipation … … 102 103 # include "vectopt_loop_substitute.h90" 103 104 !!---------------------------------------------------------------------- 104 !! NEMO/OPA 4.0 , NEMO Consortium (2011)105 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 105 106 !! $Id$ 106 107 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 117 118 & e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) , & 118 119 #endif 119 & apdlr(jpi,jpj,jpk) , htau (jpi,jpj) , dissl(jpi,jpj,jpk) , &120 & STAT= zdf_tke_alloc )120 & en (jpi,jpj,jpk) , htau (jpi,jpj) , dissl(jpi,jpj,jpk) , & 121 & apdlr(jpi,jpj,jpk) , STAT= zdf_tke_alloc ) 121 122 ! 122 123 IF( lk_mpp ) CALL mpp_sum ( zdf_tke_alloc ) … … 233 234 REAL(wp) :: zzd_up, zzd_lw ! - - 234 235 !!bfr REAL(wp) :: zebot ! - - 235 INTEGER , POINTER, DIMENSION(:,: ) :: imlc236 REAL(wp), POINTER, DIMENSION(:,: ) :: zhlc237 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw, z3du, z3dv236 INTEGER , POINTER, DIMENSION(:,: ) :: imlc 237 REAL(wp), POINTER, DIMENSION(:,: ) :: zhlc 238 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw, z3du, z3dv 238 239 REAL(wp) :: zri ! local Richardson number 239 240 !!-------------------------------------------------------------------- … … 241 242 IF( nn_timing == 1 ) CALL timing_start('tke_tke') 242 243 ! 243 CALL wrk_alloc( jpi,jpj, imlc ) ! integer244 CALL wrk_alloc( jpi,jpj, zhlc )245 CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw, z3du, z3dv )244 CALL wrk_alloc( jpi,jpj, imlc ) ! integer 245 CALL wrk_alloc( jpi,jpj, zhlc ) 246 CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw, z3du, z3dv ) 246 247 ! 247 248 zbbrau = rn_ebb / rau0 ! Local constant initialisation … … 257 258 DO jj = 2, jpjm1 ! en(mikt(ji,jj)) = rn_emin 258 259 DO ji = fs_2, fs_jpim1 ! vector opt. 259 en(ji,jj,mikt(ji,jj)) =rn_emin * tmask(ji,jj,1)260 en(ji,jj,mikt(ji,jj)) = rn_emin * tmask(ji,jj,1) 260 261 END DO 261 262 END DO … … 278 279 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 279 280 ! en(bot) = (rn_ebb0/rau0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin) 280 !CDIR NOVERRCHK281 281 !! DO jj = 2, jpjm1 282 !CDIR NOVERRCHK283 282 !! DO ji = fs_2, fs_jpim1 ! vector opt. 284 283 !! ztx2 = bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj)) + & … … 319 318 END DO 320 319 zcof = 0.016 / SQRT( zrhoa * zcdrag ) 321 !CDIR NOVERRCHK322 320 DO jk = 2, jpkm1 !* TKE Langmuir circulation source term added to en 323 !CDIR NOVERRCHK 324 DO jj = 2, jpjm1 325 !CDIR NOVERRCHK 321 DO jj = 2, jpjm1 326 322 DO ji = fs_2, fs_jpim1 ! vector opt. 327 323 zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift … … 375 371 ! 376 372 ENDIF 377 373 ! 378 374 DO jk = 2, jpkm1 !* Matrix and right hand side in en 379 375 DO jj = 2, jpjm1 … … 407 403 END DO 408 404 END DO 409 ! 410 ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 411 DO jj = 2, jpjm1 405 DO jj = 2, jpjm1 ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 412 406 DO ji = fs_2, fs_jpim1 ! vector opt. 413 407 zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1) ! Surface boudary conditions on tke … … 421 415 END DO 422 416 END DO 423 ! 424 ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 425 DO jj = 2, jpjm1 417 DO jj = 2, jpjm1 ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 426 418 DO ji = fs_2, fs_jpim1 ! vector opt. 427 419 en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) … … 464 456 END DO 465 457 ELSEIF( nn_etau == 3 ) THEN !* penetration belox the mixed layer (HF variability) 466 !CDIR NOVERRCHK467 458 DO jk = 2, jpkm1 468 !CDIR NOVERRCHK 469 DO jj = 2, jpjm1 470 !CDIR NOVERRCHK 459 DO jj = 2, jpjm1 471 460 DO ji = fs_2, fs_jpim1 ! vector opt. 472 461 ztx2 = utau(ji-1,jj ) + utau(ji,jj) … … 483 472 CALL lbc_lnk( en, 'W', 1. ) ! Lateral boundary conditions (sign unchanged) 484 473 ! 485 CALL wrk_dealloc( jpi,jpj, imlc ) ! integer486 CALL wrk_dealloc( jpi,jpj, zhlc )487 CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw, z3du, z3dv )474 CALL wrk_dealloc( jpi,jpj, imlc ) ! integer 475 CALL wrk_dealloc( jpi,jpj, zhlc ) 476 CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw, z3du, z3dv ) 488 477 ! 489 478 IF( nn_timing == 1 ) CALL timing_stop('tke_tke') … … 529 518 INTEGER :: ji, jj, jk ! dummy loop indices 530 519 REAL(wp) :: zrn2, zraug, zcoef, zav ! local scalars 531 REAL(wp) :: zdku, zri, zsqen ! - -520 REAL(wp) :: zdku, zri, zsqen ! - - 532 521 REAL(wp) :: zdkv, zemxl, zemlm, zemlp ! - - 533 522 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmpdl, zmxlm, zmxld … … 559 548 ENDIF 560 549 ! 561 !CDIR NOVERRCHK562 550 DO jk = 2, jpkm1 ! interior value : l=sqrt(2*e/n^2) 563 !CDIR NOVERRCHK 564 DO jj = 2, jpjm1 565 !CDIR NOVERRCHK 551 DO jj = 2, jpjm1 566 552 DO ji = fs_2, fs_jpim1 ! vector opt. 567 553 zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 568 zmxlm(ji,jj,jk) = MAX( rmxl_min, SQRT( 2._wp * en(ji,jj,jk) / zrn2 ) )554 zmxlm(ji,jj,jk) = MAX( rmxl_min, SQRT( 2._wp * en(ji,jj,jk) / zrn2 ) ) 569 555 END DO 570 556 END DO … … 573 559 ! !* Physical limits for the mixing length 574 560 ! 575 zmxld(:,:, 1) = zmxlm(:,:,1) ! surface set to the minimum value561 zmxld(:,:, 1 ) = zmxlm(:,:,1) ! surface set to the minimum value 576 562 zmxld(:,:,jpk) = rmxl_min ! last level set to the minimum value 577 563 ! 578 564 SELECT CASE ( nn_mxl ) 579 565 ! 566 !!gm Not sure of that coding for ISF.... 580 567 ! where wmask = 0 set zmxlm == fse3w 581 568 CASE ( 0 ) ! bounded by the distance to surface and bottom … … 636 623 END DO 637 624 END DO 638 !CDIR NOVERRCHK639 625 DO jk = 2, jpkm1 640 !CDIR NOVERRCHK 641 DO jj = 2, jpjm1 642 !CDIR NOVERRCHK 626 DO jj = 2, jpjm1 643 627 DO ji = fs_2, fs_jpim1 ! vector opt. 644 628 zemlm = MIN ( zmxld(ji,jj,jk), zmxlm(ji,jj,jk) ) … … 660 644 ! ! Vertical eddy viscosity and diffusivity (avmu, avmv, avt) 661 645 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 662 !CDIR NOVERRCHK663 646 DO jk = 1, jpkm1 !* vertical eddy viscosity & diffivity at w-points 664 !CDIR NOVERRCHK 665 DO jj = 2, jpjm1 666 !CDIR NOVERRCHK 647 DO jj = 2, jpjm1 667 648 DO ji = fs_2, fs_jpim1 ! vector opt. 668 649 zsqen = SQRT( en(ji,jj,jk) ) … … 693 674 # if defined key_c1d 694 675 e_pdl(ji,jj,jk) = apdlr(ji,jj,jk) * wmask(ji,jj,jk) ! c1d configuration : save masked Prandlt number 676 !!gm bug NO zri here.... 677 !!gm remove the specific diag for c1d ! 695 678 e_ric(ji,jj,jk) = zri * wmask(ji,jj,jk) ! c1d config. : save Ri 696 679 # endif -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
r5737 r5777 8 8 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 9 9 !!---------------------------------------------------------------------- 10 #if defined key_zdftmx || defined key_esopa10 #if defined key_zdftmx 11 11 !!---------------------------------------------------------------------- 12 12 !! 'key_zdftmx' Tidal vertical mixing -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r5770 r5777 32 32 !! 3.6 ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 33 33 !! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 34 !! 3.7 ! 2014-12 (G. Madec) suppression of cross land advection option35 34 !! - ! 2014-12 (G. Madec) remove KPP scheme and cross-land advection (cla) 36 35 !!---------------------------------------------------------------------- … … 45 44 !! factorise : calculate the factors of the no. of MPI processes 46 45 !!---------------------------------------------------------------------- 47 USE step_oce ! module used in the ocean time stepping module 46 USE step_oce ! module used in the ocean time stepping module (step.F90) 48 47 USE domcfg ! domain configuration (dom_cfg routine) 49 48 USE mppini ! shared/distributed memory setting (mpp_init routine) … … 80 79 USE lib_mpp ! distributed memory computing 81 80 #if defined key_iomput 82 USE xios 83 #endif 84 USE sbctide, ONLY : lk_tide81 USE xios ! xIOserver 82 #endif 83 USE sbctide, ONLY : lk_tide 85 84 USE crsini ! initialise grid coarsening utility 86 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges87 USE sbc_oce, ONLY : lk_oasis85 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 86 USE sbc_oce, ONLY : lk_oasis 88 87 USE stopar 89 88 USE stopts … … 194 193 ! 195 194 #if defined key_agrif 196 IF( .NOT.Agrif_Root() ) THEN197 CALL Agrif_ParentGrid_To_ChildGrid()198 IF( lk_diaobs ) CALL dia_obs_wri195 IF(.NOT.Agrif_Root() ) THEN 196 CALL Agrif_ParentGrid_To_ChildGrid() 197 IF( lk_diaobs ) CALL dia_obs_wri 199 198 IF( nn_timing == 1 ) CALL timing_finalize 200 CALL Agrif_ChildGrid_To_ParentGrid()199 CALL Agrif_ChildGrid_To_ParentGrid() 201 200 ENDIF 202 201 #endif … … 206 205 ! 207 206 #if defined key_iomput 208 CALL xios_finalize ! end mpp communications with xios209 IF( lk_oasis ) CALL cpl_finalize! end coupling and mpp communications with OASIS207 CALL xios_finalize ! end mpp communications with xios 208 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 210 209 #else 211 210 IF( lk_oasis ) THEN … … 322 321 ! If dimensions of processor grid weren't specified in the namelist file 323 322 ! then we calculate them here now that we have our communicator size 324 IF( (jpni < 1) .OR. (jpnj < 1) )THEN323 IF( jpni < 1 .OR. jpnj < 1 ) THEN 325 324 #if defined key_mpp_mpi 326 IF( Agrif_Root() ) CALL nemo_partition(mppsize)325 IF( Agrif_Root() ) CALL nemo_partition( mppsize ) 327 326 #else 328 327 jpni = 1 … … 330 329 jpnij = jpni*jpnj 331 330 #endif 332 END 331 ENDIF 333 332 334 333 ! Calculate domain dimensions given calculated jpni and jpnj 335 ! This used to be done in par_oce.F90 when they were parameters rather 336 ! than variables 334 ! This used to be done in par_oce.F90 when they were parameters rather than variables 337 335 IF( Agrif_Root() ) THEN 338 336 #if defined key_nemocice_decomp 339 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim.340 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.337 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 338 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 341 339 #else 342 jpi = ( jpiglo -2*jpreci + (jpni-1) ) / jpni + 2*jpreci! first dim.343 jpj = ( jpjglo -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj! second dim.340 jpi = ( jpiglo -2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 341 jpj = ( jpjglo -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 344 342 #endif 345 343 ENDIF 346 344 jpk = jpkdta ! third dim 347 345 #if defined key_agrif 348 ! simple trick to use same vertical grid as parent 349 ! but different number of levels: 350 ! Save maximum number of levels in jpkdta, then define all vertical grids 351 ! with this number. 346 ! simple trick to use same vertical grid as parent but different number of levels: 347 ! Save maximum number of levels in jpkdta, then define all vertical grids with this number. 352 348 ! Suppress once vertical online interpolation is ok 353 IF(.NOT.Agrif_Root()) jpkdta = Agrif_Parent(jpkdta)349 IF(.NOT.Agrif_Root()) jpkdta = Agrif_Parent( jpkdta ) 354 350 #endif 355 351 jpim1 = jpi-1 ! inner domain indices … … 408 404 IF( lk_tide ) CALL tide_init( nit000 ) ! tidal harmonics 409 405 CALL sbc_init ! surface boundary conditions (including sea-ice) 410 !!gm ==>> bdy_init should call bdy_dta_init and bdytide_init NOT nemogcm !!!406 !!gm ==>> bdy_init should call bdy_dta_init and bdytide_init NOT in nemogcm !!! 411 407 IF( lk_bdy ) CALL bdy_init ! Open boundaries initialisation 412 408 IF( lk_bdy ) CALL bdy_dta_init ! Open boundaries initialisation of external data arrays … … 518 514 WRITE(numout,*) '~~~~~~~ ' 519 515 WRITE(numout,*) ' Namelist namcfg' 520 WRITE(numout,*) ' configuration name cp_cfg= ', TRIM(cp_cfg)521 WRITE(numout,*) ' configuration zoom name cp_cfz= ', TRIM(cp_cfz)522 WRITE(numout,*) ' configuration resolution jp_cfg= ', jp_cfg523 WRITE(numout,*) ' 1st lateral dimension ( >= jpi ) jpidta= ', jpidta524 WRITE(numout,*) ' 2nd " " ( >= jpj ) jpjdta= ', jpjdta525 WRITE(numout,*) ' 3nd " " jpkdta= ', jpkdta526 WRITE(numout,*) ' 1st dimension of global domain in i jpiglo = ', jpiglo527 WRITE(numout,*) ' 2nd - - in j jpjglo = ', jpjglo516 WRITE(numout,*) ' configuration name cp_cfg = ', TRIM(cp_cfg) 517 WRITE(numout,*) ' configuration zoom name cp_cfz = ', TRIM(cp_cfz) 518 WRITE(numout,*) ' configuration resolution jp_cfg = ', jp_cfg 519 WRITE(numout,*) ' 1st lateral dimension ( >= jpiglo ) jpidta = ', jpidta 520 WRITE(numout,*) ' 2nd " " ( >= jpjglo ) jpjdta = ', jpjdta 521 WRITE(numout,*) ' 3nd " " jpkdta = ', jpkdta 522 WRITE(numout,*) ' 1st dimension of global domain in i jpiglo = ', jpiglo 523 WRITE(numout,*) ' 2nd - - in j jpjglo = ', jpjglo 528 524 WRITE(numout,*) ' left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom 529 525 WRITE(numout,*) ' left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 530 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio= ', jperio526 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio 531 527 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 532 528 ENDIF … … 625 621 USE diawri , ONLY: dia_wri_alloc 626 622 USE dom_oce , ONLY: dom_oce_alloc 627 USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc628 623 USE trc_oce , ONLY: trc_oce_alloc 629 624 #if defined key_diadct … … 640 635 ierr = ierr + dia_wri_alloc () 641 636 ierr = ierr + dom_oce_alloc () ! ocean domain 642 ierr = ierr + ldfdyn_oce_alloc() ! ocean lateral physics : dynamics643 637 ierr = ierr + zdf_oce_alloc () ! ocean vertical physics 644 638 ! … … 720 714 INTEGER :: ifac, jl, inu 721 715 INTEGER, PARAMETER :: ntest = 14 722 INTEGER, DIMENSION(ntest) :: ilfax716 INTEGER, DIMENSION(ntest) :: ilfax 723 717 !!---------------------------------------------------------------------- 724 718 ! … … 786 780 INTEGER :: njmppmax 787 781 !!---------------------------------------------------------------------- 788 782 ! 789 783 njmppmax = MAXVAL( njmppt ) 790 784 ! 791 785 !initializes the north-fold communication variables 792 786 isendto(:) = 0 793 nsndto = 0794 787 nsndto = 0 788 ! 795 789 !if I am a process in the north 796 790 IF ( njmpp == njmppmax ) THEN … … 839 833 l_north_nogather = .TRUE. 840 834 END SUBROUTINE nemo_northcomms 835 841 836 #else 842 837 SUBROUTINE nemo_northcomms ! Dummy routine … … 848 843 END MODULE nemogcm 849 844 850 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/oce.F90
r5758 r5777 7 7 !! 3.1 ! 2009-02 (G. Madec, M. Leclair) pure z* coordinate 8 8 !! 3.3 ! 2010-09 (C. Ethe) TRA-TRC merge: add ts, gtsu, gtsv 4D arrays 9 !! 3.7 ! 2014-01 (G. Madec) suppression of curl and before hdiv from in-core memory 9 10 !!---------------------------------------------------------------------- 10 11 USE par_oce ! ocean parameters … … 16 17 PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90 17 18 18 19 19 !! dynamics and tracer fields ! before ! now ! after ! the after trends becomes the fields 20 20 !! -------------------------- ! fields ! fields ! trends ! only after tra_zdf and dyn_spg 21 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ub , un , ua !: i-horizontal velocity [m/s] 22 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vb , vn , va !: j-horizontal velocity [m/s] 23 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ua_sv, va_sv !: Saved trends (time spliting) [m/s2] 24 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wn !: vertical velocity [m/s] 25 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rotb , rotn !: relative vorticity [s-1] 26 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivb, hdivn !: horizontal divergence [s-1] 21 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ub , un , ua !: i-horizontal velocity [m/s] 22 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vb , vn , va !: j-horizontal velocity [m/s] 23 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ua_sv, va_sv !: Saved trends (time spliting) [m/s2] 24 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wn !: vertical velocity [m/s] 25 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivn !: horizontal divergence [s-1] 27 26 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tsb , tsn , tsa !: 4D T-S fields [Celcius,psu] 28 27 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: rab_b, rab_n !: thermal/haline expansion coef. [Celcius-1,psu-1] … … 72 71 73 72 !!---------------------------------------------------------------------- 74 !! NEMO/OPA 4.0 , NEMO Consortium (2011)73 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 75 74 !! $Id$ 76 75 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 88 87 & vb (jpi,jpj,jpk) , vn (jpi,jpj,jpk) , va(jpi,jpj,jpk) , & 89 88 & ua_sv(jpi,jpj,jpk) , va_sv(jpi,jpj,jpk) , & 90 & wn (jpi,jpj,jpk) , & 91 & rotb (jpi,jpj,jpk) , rotn (jpi,jpj,jpk) , & 92 & hdivb(jpi,jpj,jpk) , hdivn(jpi,jpj,jpk) , & 89 & wn (jpi,jpj,jpk) , hdivn(jpi,jpj,jpk) , & 93 90 & tsb (jpi,jpj,jpk,jpts) , tsn (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) , & 94 91 & rab_b(jpi,jpj,jpk,jpts) , rab_n(jpi,jpj,jpk,jpts) , & 95 & rn2b (jpi,jpj,jpk) , rn2 (jpi,jpj,jpk) , STAT=ierr(1) ) 92 & rn2b (jpi,jpj,jpk) , rn2 (jpi,jpj,jpk) , & 93 & rhd (jpi,jpj,jpk) , rhop (jpi,jpj,jpk) , STAT=ierr(1) ) 96 94 ! 97 ALLOCATE(rhd (jpi,jpj,jpk) , & 98 & rhop(jpi,jpj,jpk) , & 99 & rke(jpi,jpj,jpk) , & 95 ALLOCATE(rke(jpi,jpj,jpk) , & 100 96 & sshb(jpi,jpj) , sshn(jpi,jpj) , ssha(jpi,jpj) , & 101 97 & ub_b(jpi,jpj) , un_b(jpi,jpj) , ua_b(jpi,jpj) , & -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
r5118 r5777 92 92 INTEGER, PUBLIC :: jpij ! = jpi*jpj !: jpi x jpj 93 93 94 !!---------------------------------------------------------------------95 !! Optimization/control flags96 !!---------------------------------------------------------------------97 #if defined key_esopa98 LOGICAL, PUBLIC, PARAMETER :: lk_esopa = .TRUE. !: flag to activate the all options99 #else100 LOGICAL, PUBLIC, PARAMETER :: lk_esopa = .FALSE. !: flag to activate the all options101 #endif102 103 94 !!---------------------------------------------------------------------- 104 95 !! NEMO/OPA 3.3 , NEMO Consortium (2010) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/step.F90
r5770 r5777 71 71 !! -5- Compute the momentum trends 72 72 !! -6- Update the horizontal velocity 73 !! -7- Compute the diagnostics variables (rd,N2, div,cur,w)73 !! -7- Compute the diagnostics variables (rd,N2, hdiv,w) 74 74 !! -8- Outputs and diagnostics 75 75 !!---------------------------------------------------------------------- … … 179 179 180 180 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 181 ! Ocean dynamics : hdiv, rot,ssh, e3, wn182 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 183 CALL ssh_nxt ( kstp ) ! after ssh (includes call to div_ cur)181 ! Ocean dynamics : hdiv, ssh, e3, wn 182 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 183 CALL ssh_nxt ( kstp ) ! after ssh (includes call to div_hor) 184 184 IF( lk_vvl ) CALL dom_vvl_sf_nxt( kstp ) ! after vertical scale factors 185 185 CALL wzv ( kstp ) ! now cross-level velocity … … 206 206 IF( lk_asminc .AND. ln_asmiau .AND. & 207 207 & ln_dyninc ) CALL dyn_asm_inc ( kstp ) ! apply dynamics assimilation increment 208 IF( ln_neptsimp ) CALL dyn_nept_cor ( kstp ) ! subtract Neptune velocities (simplified)209 208 IF( lk_bdy ) CALL bdy_dyn3d_dmp( kstp ) ! bdy damping trends 210 209 CALL dyn_adv ( kstp ) ! advection (vector or flux form) 211 210 CALL dyn_vor ( kstp ) ! vorticity term including Coriolis 212 211 CALL dyn_ldf ( kstp ) ! lateral mixing 213 IF( ln_neptsimp ) CALL dyn_nept_cor ( kstp ) ! add Neptune velocities (simplified)214 212 #if defined key_agrif 215 213 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_dyn ! momentum sponge … … 221 219 va_sv(:,:,:) = va(:,:,:) 222 220 223 CALL div_ cur( kstp ) ! Horizontal divergence & Relative vorticity(2nd call in time-split case)221 CALL div_hor( kstp ) ! Horizontal divergence (2nd call in time-split case) 224 222 IF( lk_vvl ) CALL dom_vvl_sf_nxt( kstp, kcall=2 ) ! after vertical scale factors (update depth average component) 225 223 CALL wzv ( kstp ) ! now cross-level velocity … … 311 309 ua(:,:,:) = ua_sv(:,:,:) 312 310 va(:,:,:) = va_sv(:,:,:) 313 ! Revert now divergence and rotational to previously computed ones314 !(needed because of the time swap in div_cur, at the beginning of each time step)315 hdivn(:,:,:) = hdivb(:,:,:)316 rotn(:,:,:) = rotb(:,:,:)317 311 318 312 CALL dyn_bfr( kstp ) ! bottom friction … … 325 319 & ln_dyninc ) CALL dyn_asm_inc( kstp ) ! apply dynamics assimilation increment 326 320 IF( ln_bkgwri ) CALL asm_bkg_wri( kstp ) ! output background fields 327 IF( ln_neptsimp ) CALL dyn_nept_cor( kstp ) ! subtract Neptune velocities (simplified)328 321 IF( lk_bdy ) CALL bdy_dyn3d_dmp(kstp ) ! bdy damping trends 329 322 CALL dyn_adv( kstp ) ! advection (vector or flux form) 330 323 CALL dyn_vor( kstp ) ! vorticity term including Coriolis 331 324 CALL dyn_ldf( kstp ) ! lateral mixing 332 IF( ln_neptsimp ) CALL dyn_nept_cor( kstp ) ! add Neptune velocities (simplified)333 325 #if defined key_agrif 334 326 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_dyn ! momemtum sponge -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r5758 r5777 4 4 !! Ocean time-stepping : module used in both initialisation phase and time stepping 5 5 !!====================================================================== 6 !! History : 3.3 ! 2010-08 (C. Ethe) Original code - reorganisation of the initial phase 6 !! History : 3.3 ! 2010-08 (C. Ethe) Original code - reorganisation of the initial phase 7 !! 3.7 ! 2014-01 (G. Madec) LDF simplication 7 8 !!---------------------------------------------------------------------- 8 9 USE oce ! ocean dynamics and tracers variables 9 10 USE dom_oce ! ocean space and time domain variables 10 11 USE zdf_oce ! ocean vertical physics variables 11 USE ldftra ! ocean tracer - trends12 USE ldfdyn_oce ! ocean dynamics - trends13 USE divcur ! hor. divergence and curl (div & cur routines)14 USE in_out_manager ! I/O manager15 USE iom !16 USE lbclnk17 USE restart ! restart18 #if defined key_iomput19 USE xios20 #endif21 12 22 13 USE daymod ! calendar (day routine) 23 14 24 15 USE sbc_oce ! surface boundary condition: ocean 25 USE sbc rnf ! - - - : runoff variables26 USE sbc mod ! - - - (sbc routine)27 USE sbc apr ! - - - (sbc_apr routine)28 USE sbc tide ! - - - (sbc_tide routine)29 USE sbc cpl ! - - - : coupled formulation (call send at end of step)16 USE sbcmod ! surface boundary condition (sbc routine) 17 USE sbcrnf ! surface boundary condition: runoff variables 18 USE sbccpl ! surface boundary condition: coupled formulation (call send at end of step) 19 USE sbcapr ! surface boundary condition: atmospheric pressure 20 USE sbctide ! Tide initialisation 30 21 31 22 USE traqsr ! solar radiation penetration (tra_qsr routine) … … 42 33 USE eosbn2 ! equation of state (eos_bn2 routine) 43 34 35 USE divhor ! horizontal divergence (div_hor routine) 44 36 USE dynadv ! advection (dyn_adv routine) 45 37 USE dynbfr ! Bottom friction terms (dyn_bfr routine) … … 50 42 USE dynspg_oce ! surface pressure gradient (dyn_spg routine) 51 43 USE dynspg ! surface pressure gradient (dyn_spg routine) 52 USE dynnept ! simp. form of Neptune effect(dyn_nept_cor routine)53 44 54 45 USE dynnxt ! time-stepping (dyn_nxt routine) … … 70 61 71 62 USE ldfslp ! iso-neutral slopes (ldf_slp routine) 63 USE ldfdyn ! lateral eddy viscosity coef. (ldf_dyn routine) 64 USE ldftra ! lateral eddy diffusive coef. (ldf_tra routine) 72 65 73 66 USE zdftmx ! tide-induced vertical mixing (zdf_tmx routine) … … 99 92 USE asmbkg 100 93 USE stpctl ! time stepping control (stp_ctl routine) 94 USE restart ! ocean restart (rst_wri routine) 101 95 USE prtctl ! Print control (prt_ctl routine) 102 96 103 97 USE diaobs ! Observation operator 104 98 99 USE in_out_manager ! I/O manager 100 USE iom ! 101 USE lbclnk 105 102 USE timing ! Timing 106 103 104 #if defined key_iomput 105 USE xios 106 #endif 107 107 #if defined key_agrif 108 108 USE agrif_opa_sponge ! Momemtum and tracers sponges … … 113 113 #endif 114 114 !!---------------------------------------------------------------------- 115 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)115 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 116 116 !! $Id$ 117 117 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r5766 r5777 195 195 ! CHEMICAL CONSTANTS - SURFACE LAYER 196 196 ! ---------------------------------- 197 !CDIR NOVERRCHK198 197 DO jj = 1, jpj 199 !CDIR NOVERRCHK200 198 DO ji = 1, jpi 201 199 ! ! SET ABSOLUTE TEMPERATURE … … 227 225 ! OXYGEN SOLUBILITY - DEEP OCEAN 228 226 ! ------------------------------- 229 !CDIR NOVERRCHK230 227 DO jk = 1, jpk 231 !CDIR NOVERRCHK232 228 DO jj = 1, jpj 233 !CDIR NOVERRCHK234 229 DO ji = 1, jpi 235 230 ztkel = tsn(ji,jj,jk,jp_tem) + 273.16 … … 252 247 ! CHEMICAL CONSTANTS - DEEP OCEAN 253 248 ! ------------------------------- 254 !CDIR NOVERRCHK255 249 DO jk = 1, jpk 256 !CDIR NOVERRCHK257 250 DO jj = 1, jpj 258 !CDIR NOVERRCHK259 251 DO ji = 1, jpi 260 252 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
r5766 r5777 113 113 ! Chemistry is supposed to be fast enough to be at equilibrium 114 114 ! ------------------------------------------------------------ 115 !CDIR NOVERRCHK116 115 DO jk = 1, jpkm1 117 !CDIR NOVERRCHK118 116 DO jj = 1, jpj 119 !CDIR NOVERRCHK120 117 DO ji = 1, jpi 121 118 ! Calculate ligand concentrations : assume 2/3rd of excess goes to … … 195 192 ! Chemistry is supposed to be fast enough to be at equilibrium 196 193 ! ------------------------------------------------------------ 197 !CDIR NOVERRCHK198 194 DO jk = 1, jpkm1 199 !CDIR NOVERRCHK200 195 DO jj = 1, jpj 201 !CDIR NOVERRCHK202 196 DO ji = 1, jpi 203 197 zTL1(ji,jj,jk) = ztotlig(ji,jj,jk) … … 216 210 ! 217 211 ENDIF 218 212 ! 219 213 zdust = 0. ! if no dust available 220 !CDIR NOVERRCHK 214 ! 221 215 DO jk = 1, jpkm1 222 !CDIR NOVERRCHK223 216 DO jj = 1, jpj 224 !CDIR NOVERRCHK225 217 DO ji = 1, jpi 226 218 zstep = xstep -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
r5766 r5777 122 122 123 123 DO jm = 1, 10 124 !CDIR NOVERRCHK125 124 DO jj = 1, jpj 126 !CDIR NOVERRCHK127 125 DO ji = 1, jpi 128 126 … … 155 153 ! ------------------------------------------- 156 154 157 !CDIR NOVERRCHK158 155 DO jj = 1, jpj 159 !CDIR NOVERRCHK160 156 DO ji = 1, jpi 161 157 ztc = MIN( 35., tsn(ji,jj,1,jp_tem) ) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
r5656 r5777 80 80 DO jn = 1, 5 ! BEGIN OF ITERATION 81 81 ! 82 !CDIR NOVERRCHK83 82 DO jk = 1, jpkm1 84 !CDIR NOVERRCHK85 83 DO jj = 1, jpj 86 !CDIR NOVERRCHK87 84 DO ji = 1, jpi 88 85 zfact = rhop(ji,jj,jk) / 1000. + rtrn -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r5766 r5777 95 95 ! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 96 96 DO jk = 1, jpkm1 ! -------------------------------------------------------- 97 !CDIR NOVERRCHK98 97 DO jj = 1, jpj 99 !CDIR NOVERRCHK100 98 DO ji = 1, jpi 101 99 zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + rtrn ) * 1.e6 … … 179 177 180 178 DO jk = 1, nksrp 181 !CDIR NOVERRCHK182 179 DO jj = 1, jpj 183 !CDIR NOVERRCHK184 180 DO ji = 1, jpi 185 181 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN … … 198 194 ! 199 195 DO jk = 1, nksrp 200 !CDIR NOVERRCHK201 196 DO jj = 1, jpj 202 !CDIR NOVERRCHK203 197 DO ji = 1, jpi 204 198 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN … … 264 258 ! 265 259 DO jk = 2, nksrp + 1 266 !CDIR NOVERRCHK267 260 DO jj = 1, jpj 268 !CDIR NOVERRCHK269 261 DO ji = 1, jpi 270 262 pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * xsi0r ) … … 285 277 ! 286 278 DO jk = 2, nksrp 287 !CDIR NOVERRCHK288 279 DO jj = 1, jpj 289 !CDIR NOVERRCHK290 280 DO ji = 1, jpi 291 281 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r5766 r5777 147 147 148 148 IF( ln_newprod ) THEN 149 !CDIR NOVERRCHK150 149 DO jk = 1, jpkm1 151 !CDIR NOVERRCHK152 150 DO jj = 1, jpj 153 !CDIR NOVERRCHK154 151 DO ji = 1, jpi 155 152 ! Computation of the P-I slope for nanos and diatoms … … 185 182 END DO 186 183 ELSE 187 !CDIR NOVERRCHK188 184 DO jk = 1, jpkm1 189 !CDIR NOVERRCHK190 185 DO jj = 1, jpj 191 !CDIR NOVERRCHK192 186 DO ji = 1, jpi 193 187 … … 230 224 ! Computation of a proxy of the N/C ratio 231 225 ! --------------------------------------- 232 !CDIR NOVERRCHK233 226 DO jk = 1, jpkm1 234 !CDIR NOVERRCHK235 227 DO jj = 1, jpj 236 !CDIR NOVERRCHK237 228 DO ji = 1, jpi 238 229 zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) ) & … … 295 286 296 287 ! Computation of the various production terms 297 !CDIR NOVERRCHK298 288 DO jk = 1, jpkm1 299 !CDIR NOVERRCHK300 289 DO jj = 1, jpj 301 !CDIR NOVERRCHK302 290 DO ji = 1, jpi 303 291 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN … … 330 318 331 319 IF( ln_newprod ) THEN 332 !CDIR NOVERRCHK333 320 DO jk = 1, jpkm1 334 !CDIR NOVERRCHK335 321 DO jj = 1, jpj 336 !CDIR NOVERRCHK337 322 DO ji = 1, jpi 338 323 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN … … 358 343 END DO 359 344 ELSE 360 !CDIR NOVERRCHK361 345 DO jk = 1, jpkm1 362 !CDIR NOVERRCHK363 346 DO jj = 1, jpj 364 !CDIR NOVERRCHK365 347 DO ji = 1, jpi 366 348 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90
r5766 r5777 8 8 !! ! 07-06 (C. Deltel) key_gyre : do not call lbc_lnk 9 9 !!---------------------------------------------------------------------- 10 #if defined key_top && ( defined key_trdmxl_trc || defined key_esopa )10 #if defined key_top && defined key_trdmxl_trc 11 11 !!---------------------------------------------------------------------- 12 12 !! 'key_trdmxl_trc' mixed layer trend diagnostics -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90
r5215 r5777 4 4 !! Ocean trends : set tracer and momentum trend variables 5 5 !!====================================================================== 6 #if defined key_top || defined key_esopa6 #if defined key_top 7 7 !!---------------------------------------------------------------------- 8 8 !! 'key_top' TOP models … … 30 30 # endif 31 31 32 # if defined key_trdmxl_trc || defined key_esopa32 # if defined key_trdmxl_trc 33 33 !!---------------------------------------------------------------------- 34 34 !! 'key_trdmxl_trc' mixed layer trends diagnostics -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r5758 r5777 20 20 USE par_oce , ONLY : jpkm1 => jpkm1 !: jpk - 1 21 21 USE par_oce , ONLY : jpij => jpij !: jpi x jpj 22 USE par_oce , ONLY : lk_esopa => lk_esopa !: flag to activate the all option23 22 USE par_oce , ONLY : jp_tem => jp_tem !: indice for temperature 24 23 USE par_oce , ONLY : jp_sal => jp_sal !: indice for salinity … … 50 49 USE oce , ONLY : rhd => rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 51 50 USE oce , ONLY : hdivn => hdivn !: horizontal divergence (1/s) 52 USE oce , ONLY : rotn => rotn !: relative vorticity [s-1]53 USE oce , ONLY : hdivb => hdivb !: horizontal divergence (1/s)54 USE oce , ONLY : rotb => rotb !: relative vorticity [s-1]55 51 USE oce , ONLY : sshn => sshn !: sea surface height at t-point [m] 56 52 USE oce , ONLY : sshb => sshb !: sea surface height at t-point [m] -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
r5766 r5777 25 25 USE zdf_oce 26 26 USE domvvl 27 USE div cur ! hor. divergence and curl (div & cur routines)27 USE divhor ! horizontal divergence (div_hor routine) 28 28 USE sbcrnf, ONLY: h_rnf, nk_rnf ! River runoff 29 29 USE bdy_oce … … 162 162 wndm_temp (:,:) = wndm (:,:) 163 163 ! ! Variables reset in trc_sub_ssh 164 rotn_temp (:,:,:) = rotn (:,:,:)165 164 hdivn_temp (:,:,:) = hdivn (:,:,:) 166 rotb_temp (:,:,:) = rotb (:,:,:)167 hdivb_temp (:,:,:) = hdivb (:,:,:)168 165 ! 169 166 ! 2. Create averages and reassign variables … … 401 398 ! 402 399 hdivn (:,:,:) = hdivn_temp (:,:,:) 403 rotn (:,:,:) = rotn_temp (:,:,:)404 hdivb (:,:,:) = hdivb_temp (:,:,:)405 rotb (:,:,:) = rotb_temp (:,:,:)406 400 ! 407 408 401 ! Start new averages 409 402 un_tm (:,:,:) = un (:,:,:) * fse3u(:,:,:) … … 492 485 ENDIF 493 486 ! 494 CALL div_ cur( kt ) ! Horizontal divergence & Relative vorticity487 CALL div_hor( kt ) ! Horizontal divergence & Relative vorticity 495 488 ! 496 489 z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog) … … 570 563 # endif 571 564 & hdivn_temp(jpi,jpj,jpk) , hdivb_temp(jpi,jpj,jpk), & 572 & rotn_temp(jpi,jpj,jpk) , rotb_temp(jpi,jpj,jpk), &573 565 & un_tm(jpi,jpj,jpk) , vn_tm(jpi,jpj,jpk) , & 574 566 & avt_tm(jpi,jpj,jpk) , &
Note: See TracChangeset
for help on using the changeset viewer.