@@ -48,6 +48,7 @@ module mod_params
48
48
use mod_sldepparam
49
49
use mod_sound
50
50
use mod_timer
51
+ use mod_moloch
51
52
use mod_timefilter
52
53
53
54
implicit none
@@ -622,52 +623,56 @@ subroutine param
622
623
#endif
623
624
end if
624
625
625
- upstream_mode = .true.
626
- stability_enhance = .true.
627
- if ( idynamic == 2 ) then
628
- gnu1 = 0.1000_rkx
629
- gnu2 = 0.1000_rkx
630
- diffu_hgtf = 0
631
- else
632
- gnu1 = 0.0625_rkx
633
- gnu2 = 0.0625_rkx
634
- diffu_hgtf = 1
635
- end if
636
- ckh = 1.0_rkx
637
- adyndif = 1.0_rkx
638
- uoffc = 0.250_rkx
639
- t_extrema = 5.0_rkx
640
- q_rel_extrema = 0.20_rkx
641
- rewind(ipunit)
642
- read (ipunit, nml= dynparam, iostat= iretval, err= 104 )
643
- if ( iretval /= 0 ) then
644
- write (stdout,* ) ' Using default dynamical parameters.'
645
- #ifdef DEBUG
646
- else
647
- write (stdout,* ) ' Read dynparam OK'
648
- #endif
649
- end if
650
-
651
- if ( idynamic == 2 ) then
626
+ if ( idynamic < 3 ) then
627
+ upstream_mode = .true.
628
+ stability_enhance = .true.
629
+ if ( idynamic == 2 ) then
630
+ gnu1 = 0.1000_rkx
631
+ gnu2 = 0.1000_rkx
632
+ diffu_hgtf = 0
633
+ else if ( idynamic == 1 ) then
634
+ gnu1 = 0.0625_rkx
635
+ gnu2 = 0.0625_rkx
636
+ diffu_hgtf = 1
637
+ end if
638
+ ckh = 1.0_rkx
639
+ adyndif = 1.0_rkx
640
+ uoffc = 0.250_rkx
641
+ t_extrema = 5.0_rkx
642
+ q_rel_extrema = 0.20_rkx
652
643
rewind(ipunit)
653
- read (ipunit, nml= nonhydroparam , iostat= iretval, err= 105 )
644
+ read (ipunit, nml= dynparam , iostat= iretval, err= 104 )
654
645
if ( iretval /= 0 ) then
655
- write (stdout,* ) ' Using default non-hydrostatc parameters.'
646
+ write (stdout,* ) ' Using default dynamical parameters.'
656
647
#ifdef DEBUG
657
648
else
658
- write (stdout,* ) ' Read nonhydroparam OK'
649
+ write (stdout,* ) ' Read dynparam OK'
659
650
#endif
660
651
end if
661
- else
662
- rewind(ipunit)
663
- read (ipunit, nml= hydroparam, iostat= iretval, err= 106 )
664
- if ( iretval /= 0 ) then
665
- write (stdout,* ) ' Using default hydrostatc parameters.'
652
+
653
+ if ( idynamic == 2 ) then
654
+ rewind(ipunit)
655
+ read (ipunit, nml= nonhydroparam, iostat= iretval, err= 105 )
656
+ if ( iretval /= 0 ) then
657
+ write (stdout,* ) ' Using default non-hydrostatc parameters.'
666
658
#ifdef DEBUG
667
- else
668
- write (stdout,* ) ' Read hydroparam OK'
659
+ else
660
+ write (stdout,* ) ' Read nonhydroparam OK'
669
661
#endif
662
+ end if
663
+ else if ( idynamic == 1 ) then
664
+ rewind(ipunit)
665
+ read (ipunit, nml= hydroparam, iostat= iretval, err= 106 )
666
+ if ( iretval /= 0 ) then
667
+ write (stdout,* ) ' Using default hydrostatc parameters.'
668
+ #ifdef DEBUG
669
+ else
670
+ write (stdout,* ) ' Read hydroparam OK'
671
+ #endif
672
+ end if
670
673
end if
674
+ else
675
+ ! Moloch dynamic
671
676
end if
672
677
673
678
! Hack. permanently disable seasonal albedo.
@@ -1108,7 +1113,9 @@ subroutine param
1108
1113
call bcast(ichem)
1109
1114
call bcast(ntr)
1110
1115
1111
- if ( idynamic == 2 ) then
1116
+ if ( idynamic == 3 ) then
1117
+ ! Moloch paramters here
1118
+ else if ( idynamic == 2 ) then
1112
1119
call bcast(base_state_pressure)
1113
1120
call bcast(logp_lrate)
1114
1121
call bcast(ifupr)
@@ -1519,6 +1526,8 @@ subroutine param
1519
1526
1520
1527
if ( idynamic == 2 ) then
1521
1528
call allocate_mod_sound
1529
+ else if ( idynamic == 3 ) then
1530
+ call allocate_moloch
1522
1531
end if
1523
1532
1524
1533
call allocate_mod_diffusion
@@ -2396,6 +2405,8 @@ subroutine param
2396
2405
if ( idynamic == 2 ) then
2397
2406
call make_reference_atmosphere
2398
2407
call compute_full_coriolis_coefficients
2408
+ else if ( idynamic == 3 ) then
2409
+ call compute_latfac
2399
2410
end if
2400
2411
2401
2412
if ( iboudy < 0 .or. iboudy > 5 ) then
@@ -2624,6 +2635,17 @@ subroutine compute_full_coriolis_coefficients
2624
2635
end if
2625
2636
end subroutine compute_full_coriolis_coefficients
2626
2637
2638
+ subroutine compute_latfac
2639
+ implicit none
2640
+ integer :: i , j
2641
+ do i = ice1 , ice2
2642
+ do j = jce1 , jce2
2643
+ mddom% clv(j,i) = cos (mddom% xlat(j,i))
2644
+ mddom% clv(j,i) = 1.0_rkx / cos (mddom% xlat(j,i))
2645
+ end do
2646
+ end do
2647
+ end subroutine compute_latfac
2648
+
2627
2649
recursive integer function gcd_rec(u,v) result(gcd)
2628
2650
implicit none
2629
2651
integer , intent (in ) :: u , v
0 commit comments