source: codes/icosagcm/trunk/src/physics/physics_lmdz_generic.F90 @ 548

Last change on this file since 548 was 548, checked in by dubos, 7 years ago

trunk : reorganize source tree
File size: 17.6 KB
Line 
1MODULE physics_lmdz_generic_mod
2  USE field_mod
3  USE transfert_mod
4 
5  INTEGER,SAVE :: nbp_phys
6  TYPE(t_message) :: req_u
7
8  TYPE(t_field),POINTER :: f_p(:) 
9  TYPE(t_field),POINTER :: f_pks(:) 
10  TYPE(t_field),POINTER :: f_pk(:) 
11  TYPE(t_field),POINTER :: f_p_layer(:)   
12  TYPE(t_field),POINTER :: f_theta(:)   
13  TYPE(t_field),POINTER :: f_phi(:)   
14  TYPE(t_field),POINTER :: f_Temp(:)   
15  TYPE(t_field),POINTER :: f_ulon(:)   
16  TYPE(t_field),POINTER :: f_ulat(:)   
17  TYPE(t_field),POINTER :: f_dulon(:)
18  TYPE(t_field),POINTER :: f_dulat(:)
19  TYPE(t_field),POINTER :: f_dTemp(:)
20  TYPE(t_field),POINTER :: f_dq(:)
21  TYPE(t_field),POINTER :: f_dps(:)
22  TYPE(t_field),POINTER :: f_duc(:)
23
24  INTEGER :: start_clock
25  INTEGER :: stop_clock
26  INTEGER :: count_clock=0
27 
28  REAL :: start_day
29  REAL :: day_length
30  REAL :: year_length
31 
32 INTEGER,ALLOCATABLE,SAVE :: domain_offset(:)
33
34 
35
36CONTAINS
37
38  SUBROUTINE init_physics
39  USE icosa
40  USE domain_mod
41  USE dimensions
42  USE mpi_mod
43  USE mpipara
44  USE disvert_mod
45  USE xios_mod
46 
47  IMPLICIT NONE
48  INTEGER  :: distrib(0:mpi_size-1)
49  INTEGER  :: ind,i,j,ij,pos
50
51  REAL(rstd),ALLOCATABLE :: latfi(:)
52  REAL(rstd),ALLOCATABLE :: lonfi(:)
53  REAL(rstd),ALLOCATABLE :: airefi(:)
54  REAL(rstd),ALLOCATABLE :: bounds_latfi(:,:)
55  REAL(rstd),ALLOCATABLE :: bounds_lonfi(:,:)
56
57    start_day=0
58    day_length=86400
59    year_length=86400*365.25
60   
61    CALL getin('start_day',start_day)
62    CALL getin('day_length',day_length)
63    CALL getin('year_length',year_length)
64
65!$OMP PARALLEL
66    CALL allocate_field(f_p,field_t,type_real,llm+1)
67    CALL allocate_field(f_pks,field_t,type_real)
68    CALL allocate_field(f_pk,field_t,type_real,llm)
69    CALL allocate_field(f_p_layer,field_t,type_real,llm)
70    CALL allocate_field(f_theta,field_t,type_real,llm)
71    CALL allocate_field(f_phi,field_t,type_real,llm)
72    CALL allocate_field(f_Temp,field_t,type_real,llm)
73    CALL allocate_field(f_ulon,field_t,type_real,llm)
74    CALL allocate_field(f_ulat,field_t,type_real,llm)
75    CALL allocate_field(f_dulon,field_t,type_real,llm)
76    CALL allocate_field(f_dulat,field_t,type_real,llm)
77    CALL allocate_field(f_dTemp,field_t,type_real,llm)
78    CALL allocate_field(f_dq,field_t,type_real,llm,nqtot)
79    CALL allocate_field(f_dps,field_t,type_real)
80    CALL allocate_field(f_duc,field_t,type_real,3,llm)   
81!$OMP END PARALLEL   
82
83    ALLOCATE(domain_offset(ndomain))
84    nbp_phys=0
85    domain_offset(1)=0
86    DO ind=1,ndomain
87      CALL swap_dimensions(ind)
88      IF (ind<ndomain) THEN
89        domain_offset(ind+1)=domain_offset(ind)+ii_nb*jj_nb
90      ENDIF
91      nbp_phys=nbp_phys+ii_nb*jj_nb
92    ENDDO
93   
94    CALL MPI_ALLGATHER(nbp_phys,1,MPI_INTEGER,distrib,1,MPI_INTEGER,comm_icosa,ierr)
95   
96    ALLOCATE(latfi(nbp_phys))
97    ALLOCATE(lonfi(nbp_phys))
98    ALLOCATE(airefi(nbp_phys))
99    ALLOCATE(bounds_latfi(nbp_phys,6))
100    ALLOCATE(bounds_lonfi(nbp_phys,6))
101   
102    pos=0
103    DO ind=1,ndomain
104      CALL swap_dimensions(ind)
105      CALL swap_geometry(ind)
106      DO j=jj_begin,jj_end
107        DO i=ii_begin,ii_end
108          ij=(j-1)*iim+i
109          pos=pos+1
110          CALL xyz2lonlat(xyz_i(ij,:),lonfi(pos),latfi(pos))
111          CALL xyz2lonlat(xyz_v(ij+z_rup,:), bounds_lonfi(pos,1), bounds_latfi(pos,1))
112          CALL xyz2lonlat(xyz_v(ij+z_up,:), bounds_lonfi(pos,2), bounds_latfi(pos,2))
113          CALL xyz2lonlat(xyz_v(ij+z_lup,:), bounds_lonfi(pos,3), bounds_latfi(pos,3))
114          CALL xyz2lonlat(xyz_v(ij+z_ldown,:), bounds_lonfi(pos,4), bounds_latfi(pos,4))
115          CALL xyz2lonlat(xyz_v(ij+z_down,:), bounds_lonfi(pos,5), bounds_latfi(pos,5))
116          CALL xyz2lonlat(xyz_v(ij+z_rdown,:), bounds_lonfi(pos,6), bounds_latfi(pos,6))
117          airefi(pos)=Ai(ij) 
118        ENDDO
119      ENDDO
120    ENDDO
121
122
123#ifdef CPP_PHYSICS_LMDZ_GENERIC
124    CALL initialize_unstructured_physics(nbp_phys,llm, comm_icosa, mpi_size,distrib,            &
125                                         day_length,start_day,itau_physics*dt,                  &
126                                         6,latfi,lonfi,airefi,bounds_lonfi,bounds_latfi,         &
127                                         radius,g, gas_constant/mu, cpp,                        &
128                                         preff, ap, bp)                                         
129#endif
130   
131    CALL xios_set_context   
132   
133!    CALL init_phys_lmdz(128,97,llm, comm_icosa, mpi_size, distrib)
134   
135#ifdef CPP_PHYSICS_LMDZ_GENERIC
136    CALL init_gcm_lmdz(nbp_phys,mpi_size,distrib,latfi,lonfi,airefi)
137#endif
138!    CALL init_phys_lmdz(128,97,llm, comm_icosa, mpi_size, distrib)
139!    CALL iniphysiq(llm,day_length,start_day,itau_physics*dt,     &
140!                   latfi,lonfi,airefi,radius,g, gas_constant/mu, cpp,     &
141!                   ap, bp)
142   
143   
144   
145  END SUBROUTINE init_physics
146 
147  SUBROUTINE physics(it,f_phis, f_ps, f_theta_rhodz, f_u, f_wflux, f_q)
148  USE ICOSA
149  USE time_mod
150  USE disvert_mod
151  USE transfert_mod
152  USE mpipara
153  USE xios_mod
154  USE trace
155  IMPLICIT NONE
156    INTEGER,INTENT(IN)    :: it
157    TYPE(t_field),POINTER :: f_phis(:)
158    TYPE(t_field),POINTER :: f_ps(:)
159    TYPE(t_field),POINTER :: f_theta_rhodz(:)
160    TYPE(t_field),POINTER :: f_u(:)
161    TYPE(t_field),POINTER :: f_wflux(:)
162    TYPE(t_field),POINTER :: f_q(:)
163 
164    REAL(rstd),POINTER :: phis(:)
165    REAL(rstd),POINTER :: ps(:)
166    REAL(rstd),POINTER :: theta_rhodz(:,:)
167    REAL(rstd),POINTER :: u(:,:)
168    REAL(rstd),POINTER :: wflux(:,:)
169    REAL(rstd),POINTER :: q(:,:,:)
170    REAL(rstd),POINTER :: p(:,:)
171    REAL(rstd),POINTER :: pks(:)
172    REAL(rstd),POINTER :: pk(:,:)
173    REAL(rstd),POINTER :: p_layer(:,:)
174    REAL(rstd),POINTER :: theta(:,:)
175    REAL(rstd),POINTER :: phi(:,:)
176    REAL(rstd),POINTER :: Temp(:,:)
177    REAL(rstd),POINTER :: ulon(:,:)
178    REAL(rstd),POINTER :: ulat(:,:)
179    REAL(rstd),POINTER :: dulon(:,:)
180    REAL(rstd),POINTER :: dulat(:,:)
181    REAL(rstd),POINTER :: dTemp(:,:)
182    REAL(rstd),POINTER :: dq(:,:,:)
183    REAL(rstd),POINTER :: dps(:)
184    REAL(rstd),POINTER :: duc(:,:,:)
185
186
187    INTEGER :: ind
188   
189    REAL(rstd),ALLOCATABLE,SAVE :: ps_phy(:)
190    REAL(rstd),ALLOCATABLE,SAVE :: p_phy(:,:)
191    REAL(rstd),ALLOCATABLE,SAVE :: p_layer_phy(:,:)
192    REAL(rstd),ALLOCATABLE,SAVE :: Temp_phy(:,:)
193    REAL(rstd),ALLOCATABLE,SAVE :: phis_phy(:)
194    REAL(rstd),ALLOCATABLE,SAVE :: phi_phy(:,:)
195    REAL(rstd),ALLOCATABLE,SAVE :: ulon_phy(:,:)
196    REAL(rstd),ALLOCATABLE,SAVE :: ulat_phy(:,:)
197    REAL(rstd),ALLOCATABLE,SAVE :: q_phy(:,:,:)
198    REAL(rstd),ALLOCATABLE,SAVE :: wflux_phy(:,:)
199    REAL(rstd),ALLOCATABLE,SAVE :: dulon_phy(:,:)
200    REAL(rstd),ALLOCATABLE,SAVE :: dulat_phy(:,:)
201    REAL(rstd),ALLOCATABLE,SAVE :: dTemp_phy(:,:)
202    REAL(rstd),ALLOCATABLE,SAVE :: dq_phy(:,:,:)
203    REAL(rstd),ALLOCATABLE,SAVE :: dps_phy(:)
204    REAL(rstd) :: dtphy 
205    REAL(rstd) :: time
206    REAL(rstd) :: day
207    REAL(rstd) :: real_time
208    INTEGER    :: offset
209    LOGICAL :: lafin=.FALSE.
210    LOGICAL,SAVE :: first=.TRUE.
211!$OMP THREADPRIVATE(first)
212
213   
214    IF (first) THEN
215      first=.FALSE.
216      CALL init_message(f_u,req_e1_vect,req_u)
217!$OMP MASTER
218      ALLOCATE(ps_phy(nbp_phys))
219      ALLOCATE(p_phy(nbp_phys,llm+1))
220      ALLOCATE(p_layer_phy(nbp_phys,llm))
221      ALLOCATE(Temp_phy(nbp_phys,llm))
222      ALLOCATE(phis_phy(nbp_phys))
223      ALLOCATE(phi_phy(nbp_phys,llm))
224      ALLOCATE(ulon_phy(nbp_phys,llm))
225      ALLOCATE(ulat_phy(nbp_phys,llm))
226      ALLOCATE(q_phy(nbp_phys,llm,nqtot))
227      ALLOCATE(wflux_phy(nbp_phys,llm))
228      ALLOCATE(dulon_phy(nbp_phys,llm))
229      ALLOCATE(dulat_phy(nbp_phys,llm))
230      ALLOCATE(dTemp_phy(nbp_phys,llm))
231      ALLOCATE(dq_phy(nbp_phys,llm,nqtot))
232      ALLOCATE(dps_phy(nbp_phys))
233     
234!$OMP END MASTER
235!$OMP BARRIER
236    ENDIF
237
238    IF(it==itaumax) THEN
239      lafin=.TRUE.
240    ELSE
241      lafin=.FALSE.
242    ENDIF
243
244!$OMP MASTER       
245!    CALL update_calendar(it)
246!$OMP END MASTER
247!$OMP BARRIER
248    dtphy=itau_physics*dt
249    real_time=start_day*day_length+it*dt
250    day  = INT( MODULO(real_time,year_length) / day_length) 
251    time = MODULO(real_time,day_length) / day_length
252
253!$OMP MASTER   
254    IF (is_mpi_root) PRINT*,"Enterring in physic : day", day, "  time : ",time 
255!$OMP END MASTER   
256   
257   
258   
259   
260    CALL transfert_message(f_u,req_u)
261   
262    DO ind=1,ndomain
263      CALL swap_dimensions(ind)
264      IF (assigned_domain(ind)) THEN
265        offset=domain_offset(ind)
266        CALL swap_geometry(ind)
267     
268        phis=f_phis(ind)
269        ps=f_ps(ind)
270        theta_rhodz=f_theta_rhodz(ind)
271        u=f_u(ind)
272        q=f_q(ind)
273        wflux=f_wflux(ind)
274        p=f_p(ind)
275        pks=f_pks(ind)
276        pk=f_pk(ind)
277        p_layer=f_p_layer(ind)
278        theta=f_theta(ind)
279        phi=f_phi(ind)
280        Temp=f_Temp(ind)
281        ulon=f_ulon(ind)
282        ulat=f_ulat(ind)
283           
284        CALL grid_icosa_to_physics
285
286      ENDIF
287    ENDDO
288
289!$OMP BARRIER
290!$OMP MASTER
291    CALL SYSTEM_CLOCK(start_clock)
292!$OMP END MASTER
293    CALL trace_start("physic")
294!    CALL trace_off()
295
296#ifdef CPP_PHYSICS_LMDZ_GENERIC
297    CALL calfis_icosa(dtphy, lafin, day, time, presnivs,      &
298                      p_phy, p_layer_phy, phi_phy, phis_phy, ulon_phy, ulat_phy, Temp_phy, q_phy, wflux_phy, &
299                      dulon_phy, dulat_phy, dTemp_phy, dq_phy, dps_phy  )
300#endif
301!    CALL trace_on()
302    CALL trace_end("physic")
303!$OMP MASTER
304    CALL SYSTEM_CLOCK(stop_clock)
305    count_clock=count_clock+stop_clock-start_clock
306!$OMP END MASTER
307
308!$OMP BARRIER                       
309
310    DO ind=1,ndomain
311      CALL swap_dimensions(ind)
312      IF (assigned_domain(ind)) THEN
313        CALL swap_geometry(ind)
314        offset=domain_offset(ind)
315     
316        theta_rhodz=f_theta_rhodz(ind)
317        u=f_u(ind)
318        q=f_q(ind)
319        ps=f_ps(ind)
320        dulon=f_dulon(ind)
321        dulat=f_dulat(ind)
322        Temp=f_temp(ind)
323        dTemp=f_dTemp(ind)
324        dq=f_dq(ind)
325        dps=f_dps(ind)
326        duc=f_duc(ind)
327        p=f_p(ind)
328        pks=f_pks(ind)
329        pk=f_pk(ind)
330     
331        CALL grid_physics_to_icosa
332      ENDIF
333    ENDDO
334
335!$OMP BARRIER
336    CALL xios_set_context   
337     
338  CONTAINS
339   
340    SUBROUTINE grid_physics_to_icosa
341    USE theta2theta_rhodz_mod
342    USE omp_para
343    IMPLICIT NONE
344      INTEGER :: i,j,ij,l,iq
345         
346      DO j=jj_begin,jj_end
347        DO i=ii_begin,ii_end
348          ij=(j-1)*iim+i
349          offset=offset+1
350         
351          dulon(ij,ll_begin:ll_end)=dulon_phy(offset,ll_begin:ll_end)
352          dulat(ij,ll_begin:ll_end)=dulat_phy(offset,ll_begin:ll_end)
353          dTemp(ij,ll_begin:ll_end)=dTemp_phy(offset,ll_begin:ll_end)
354          Temp(ij,ll_begin:ll_end) = Temp_phy(offset,ll_begin:ll_end)
355          dq(ij,ll_begin:ll_end,:)=dq_phy(offset,ll_begin:ll_end,:)
356          if (is_omp_first_level) dps(ij)=dps_phy(offset)
357        ENDDO
358      ENDDO
359   
360      DO l=ll_begin,ll_end
361        DO j=jj_begin,jj_end
362          DO i=ii_begin,ii_end
363            ij=(j-1)*iim+i
364            duc(ij,:,l)=dulon(ij,l)*elon_i(ij,:)+dulat(ij,l)*elat_i(ij,:)
365          ENDDO
366        ENDDO
367      ENDDO
368
369      DO l=ll_begin,ll_end
370        DO j=jj_begin,jj_end
371          DO i=ii_begin,ii_end
372            ij=(j-1)*iim+i
373            u(ij+u_right,l) = u(ij+u_right,l) + dtphy * sum( 0.5*(duc(ij,:,l) + duc(ij+t_right,:,l))*ep_e(ij+u_right,:) )
374            u(ij+u_lup,l) = u(ij+u_lup,l) + dtphy * sum( 0.5*(duc(ij,:,l) + duc(ij+t_lup,:,l))*ep_e(ij+u_lup,:) )
375            u(ij+u_ldown,l) = u(ij+u_ldown,l) + dtphy*sum( 0.5*(duc(ij,:,l) + duc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:) )
376          ENDDO
377        ENDDO
378      ENDDO         
379
380      DO l=ll_begin,ll_end
381        DO j=jj_begin,jj_end
382          DO i=ii_begin,ii_end
383            ij=(j-1)*iim+i
384            Temp(ij,l)=Temp(ij,l)+ dtphy * dTemp(ij,l)
385          ENDDO
386        ENDDO
387      ENDDO         
388     
389      DO iq=1,nqtot
390        DO l=ll_begin,ll_end
391          DO j=jj_begin,jj_end
392            DO i=ii_begin,ii_end
393              ij=(j-1)*iim+i
394              q(ij,l,iq)=q(ij,l,iq)+ dtphy * dq(ij,l,iq)
395            ENDDO
396          ENDDO
397        ENDDO 
398      ENDDO
399
400!$OMP BARRIER
401     
402     IF (is_omp_first_level) THEN
403       DO j=jj_begin,jj_end
404         DO i=ii_begin,ii_end
405           ij=(j-1)*iim+i
406           ps(ij)=ps(ij)+ dtphy * dps(ij)
407          ENDDO
408       ENDDO
409     ENDIF
410
411!     CALL compute_temperature2theta_rhodz(ps,Temp,theta_rhodz,0)
412
413! compute pression
414!$OMP BARRIER
415      DO    l    = ll_begin,ll_endp1
416        DO j=jj_begin,jj_end
417          DO i=ii_begin,ii_end
418            ij=(j-1)*iim+i
419            p(ij,l) = ap(l) + bp(l) * ps(ij)
420          ENDDO
421        ENDDO
422      ENDDO
423
424!$OMP BARRIER
425
426! compute exner
427       
428       IF (is_omp_first_level) THEN
429         DO j=jj_begin,jj_end
430            DO i=ii_begin,ii_end
431               ij=(j-1)*iim+i
432               pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
433            ENDDO
434         ENDDO
435       ENDIF
436
437       ! 3D : pk
438       DO l = ll_begin,ll_end
439          DO j=jj_begin,jj_end
440             DO i=ii_begin,ii_end
441                ij=(j-1)*iim+i
442                pk(ij,l) = cpp * ((.5/preff)*(p(ij,l)+p(ij,l+1))) ** kappa
443             ENDDO
444          ENDDO
445       ENDDO
446
447!$OMP BARRIER
448
449!   compute theta, temperature and pression at layer
450    DO    l    = ll_begin, ll_end
451      DO j=jj_begin,jj_end
452        DO i=ii_begin,ii_end
453          ij=(j-1)*iim+i
454          theta_rhodz(ij,l) = temp(ij,l) * ((p(ij,l)-p(ij,l+1))/g) / (pk(ij,l) / cpp )
455        ENDDO
456      ENDDO
457    ENDDO
458   
459    END SUBROUTINE grid_physics_to_icosa
460   
461   
462    SUBROUTINE grid_icosa_to_physics
463    USE pression_mod
464    USE exner_mod
465    USE theta2theta_rhodz_mod
466    USE geopotential_mod
467    USE wind_mod
468    USE omp_para
469    IMPLICIT NONE
470   
471    REAL(rstd) :: uc(3)
472    INTEGER :: i,j,ij,l
473   
474
475! compute pression
476
477      DO    l    = ll_begin,ll_endp1
478        DO j=jj_begin,jj_end
479          DO i=ii_begin,ii_end
480            ij=(j-1)*iim+i
481            p(ij,l) = ap(l) + bp(l) * ps(ij)
482          ENDDO
483        ENDDO
484      ENDDO
485
486!$OMP BARRIER
487
488! compute exner
489       
490       IF (is_omp_first_level) THEN
491         DO j=jj_begin,jj_end
492            DO i=ii_begin,ii_end
493               ij=(j-1)*iim+i
494               pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
495            ENDDO
496         ENDDO
497       ENDIF
498
499       ! 3D : pk
500       DO l = ll_begin,ll_end
501          DO j=jj_begin,jj_end
502             DO i=ii_begin,ii_end
503                ij=(j-1)*iim+i
504                pk(ij,l) = cpp * ((.5/preff)*(p(ij,l)+p(ij,l+1))) ** kappa
505             ENDDO
506          ENDDO
507       ENDDO
508
509!$OMP BARRIER
510
511!   compute theta, temperature and pression at layer
512    DO    l    = ll_begin, ll_end
513      DO j=jj_begin,jj_end
514        DO i=ii_begin,ii_end
515          ij=(j-1)*iim+i
516          theta(ij,l) = theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g)
517          Temp(ij,l) = theta(ij,l) * pk(ij,l) / cpp
518          p_layer(ij,l)=preff*(pk(ij,l)/cpp)**(1./kappa) 
519        ENDDO
520      ENDDO
521    ENDDO
522
523
524!!! Compute geopotential
525       
526  ! for first layer
527  IF (is_omp_first_level) THEN
528    DO j=jj_begin,jj_end
529      DO i=ii_begin,ii_end
530        ij=(j-1)*iim+i
531        phi( ij,1 ) = phis( ij ) + theta(ij,1) * ( pks(ij) - pk(ij,1) )
532      ENDDO
533    ENDDO
534  ENDIF
535!!-> implicit flush on phi(:,1)
536         
537  ! for other layers
538  DO l = ll_beginp1, ll_end
539    DO j=jj_begin,jj_end
540      DO i=ii_begin,ii_end
541        ij=(j-1)*iim+i
542        phi(ij,l) =  0.5 * ( theta(ij,l)  + theta(ij,l-1) )  & 
543                         * (  pk(ij,l-1) -  pk(ij,l)    )
544      ENDDO
545    ENDDO
546  ENDDO       
547
548!$OMP BARRIER
549
550
551  IF (is_omp_first_level) THEN
552    DO l = 2, llm
553      DO j=jj_begin,jj_end
554! ---> Bug compilo intel ici en openmp
555! ---> Couper la boucle
556       IF (j==jj_end+1) PRINT*,"this message must not be printed"
557        DO i=ii_begin,ii_end
558          ij=(j-1)*iim+i
559          phi(ij,l) = phi(ij,l)+ phi(ij,l-1)
560        ENDDO
561      ENDDO
562    ENDDO
563! --> IMPLICIT FLUSH on phi --> non
564  ENDIF 
565
566! compute wind centered lon lat compound
567    DO l=ll_begin,ll_end
568      DO j=jj_begin,jj_end
569        DO i=ii_begin,ii_end
570          ij=(j-1)*iim+i
571          uc(:)=1/Ai(ij)*                                                                                                &
572                        ( ne(ij,right)*u(ij+u_right,l)*le(ij+u_right)*((xyz_v(ij+z_rdown,:)+xyz_v(ij+z_rup,:))/2-centroid(ij,:))  &
573                         + ne(ij,rup)*u(ij+u_rup,l)*le(ij+u_rup)*((xyz_v(ij+z_rup,:)+xyz_v(ij+z_up,:))/2-centroid(ij,:))          &
574                         + ne(ij,lup)*u(ij+u_lup,l)*le(ij+u_lup)*((xyz_v(ij+z_up,:)+xyz_v(ij+z_lup,:))/2-centroid(ij,:))          &
575                         + ne(ij,left)*u(ij+u_left,l)*le(ij+u_left)*((xyz_v(ij+z_lup,:)+xyz_v(ij+z_ldown,:))/2-centroid(ij,:))    &
576                         + ne(ij,ldown)*u(ij+u_ldown,l)*le(ij+u_ldown)*((xyz_v(ij+z_ldown,:)+xyz_v(ij+z_down,:))/2-centroid(ij,:))&
577                         + ne(ij,rdown)*u(ij+u_rdown,l)*le(ij+u_rdown)*((xyz_v(ij+z_down,:)+xyz_v(ij+z_rdown,:))/2-centroid(ij,:)))
578          ulon(ij,l)=sum(uc(:)*elon_i(ij,:))
579          ulat(ij,l)=sum(uc(:)*elat_i(ij,:)) 
580        ENDDO
581      ENDDO
582    ENDDO
583
584!$OMP BARRIER
585
586
587     
588      DO j=jj_begin,jj_end
589        DO i=ii_begin,ii_end
590          ij=(j-1)*iim+i
591          offset=offset+1
592
593          IF (is_omp_first_level) ps_phy(offset) = ps(ij)
594          p_phy(offset,ll_begin:ll_endp1) = p(ij,ll_begin:ll_endp1)
595          p_layer_phy(offset,ll_begin:ll_end) = p_layer(ij,ll_begin:ll_end)
596          Temp_phy(offset,ll_begin:ll_end) = Temp(ij,ll_begin:ll_end)
597          IF (is_omp_first_level) phis_phy(offset) = phis(ij)
598          phi_phy(offset,ll_begin:ll_end) = phi(ij,ll_begin:ll_end)-phis(ij)
599          ulon_phy(offset,ll_begin:ll_end) = ulon(ij,ll_begin:ll_end)
600          ulat_phy(offset,ll_begin:ll_end) = ulat(ij,ll_begin:ll_end)
601          q_phy(offset,ll_begin:ll_end,:) = q(ij,ll_begin:ll_end,:)
602          wflux_phy(offset,ll_begin:ll_end) = wflux(ij,ll_begin:ll_end)
603        ENDDO
604      ENDDO
605     
606     END SUBROUTINE grid_icosa_to_physics
607
608  END SUBROUTINE physics
609 
610 
611END MODULE physics_lmdz_generic_mod
612   
613 
Note: See TracBrowser for help on using the repository browser.