46 subroutine set_tracer_profile_(model, n, tracer, err_msg)
48 integer,
intent(in) :: model
49 integer,
intent(in) :: n
50 real(FMS_TM_KIND_),
intent(inout),
dimension(:,:,:) :: tracer
51 character(len=*),
intent(out),
optional :: err_msg
53 real(FMS_TM_KIND_) :: surf_value, multiplier
54 integer :: numlevels, k, n1, flag
55 real(FMS_TM_KIND_) :: top_value, bottom_value
56 character(len=80) :: scheme, control,profile_type
57 character(len=128) :: err_msg_local
58 character(len=11) :: chn
60 integer,
parameter :: lkind=fms_tm_kind_
62 if(.not.module_is_initialized)
call tracer_manager_init
64 if (n < 1 .or. n > total_tracers(model))
then
66 err_msg_local =
' Invalid tracer index. Model name = '//trim(model_names(model))//
', Index='//trim(chn)
67 if(error_handler(
'set_tracer_profile', err_msg_local, err_msg))
return
69 n1 = tracer_array(model,n)
72 profile_type =
'Fixed'
73 surf_value = 0.0e+00_lkind
74 top_value = surf_value
75 bottom_value = surf_value
76 multiplier = 1.0_lkind
80 if ( query_method(
'profile_type',model,n,scheme,control))
then
83 if(lowercase(trim(scheme(1:5))).eq.
'fixed')
then
84 profile_type =
'Fixed'
85 flag =parse(control,
'surface_value',surf_value)
86 multiplier = 1.0_lkind
90 if(lowercase(trim(scheme(1:7))).eq.
'profile')
then
91 profile_type =
'Profile'
92 flag=parse(control,
'surface_value',surf_value)
93 if (surf_value .eq. 0.0_lkind) &
94 call mpp_error(fatal,
'set_tracer_profile : Cannot have a zero surface value for an exponential profile. Tracer '&
95 //tracers(n1)%tracer_name//
" "//control//
" "//scheme)
96 select case (tracers(n1)%model)
98 flag=parse(control,
'top_value',top_value)
99 if(
mpp_pe()==mpp_root_pe() .and. flag == 0) &
100 call mpp_error(note,
'set_tracer_profile : Parameter top_value needs to be defined for the tracer profile.')
102 flag =parse(control,
'bottom_value',bottom_value)
103 if(
mpp_pe() == mpp_root_pe() .and. flag == 0) &
104 call mpp_error(note, &
105 &
'set_tracer_profile : Parameter bottom_value needs to be defined for the tracer profile.')
117 numlevels =
size(tracer,3) -1
118 select case (tracers(n1)%model)
120 multiplier = exp( log(top_value/surf_value) /real(numlevels,lkind))
121 tracer(:,:,1) = surf_value
122 do k = 2,
size(tracer,3)
123 tracer(:,:,k) = tracer(:,:,k-1) * multiplier
126 multiplier = exp( log(bottom_value/surf_value) / real(numlevels,lkind))
127 tracer(:,:,
size(tracer,3)) = surf_value
128 do k =
size(tracer,3) - 1, 1, -1
129 tracer(:,:,k) = tracer(:,:,k+1) * multiplier
135 if (
mpp_pe() == mpp_root_pe() )
write(*,700)
'Tracer ',trim(tracers(n1)%tracer_name), &
136 ' initialized with surface value of ',surf_value, &
137 ' and vertical multiplier of ',multiplier
138 700
FORMAT (3a,e13.6,a,f13.6)
142 end subroutine set_tracer_profile_
integer function mpp_pe()
Returns processor ID.