source: codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/physics_lmdz_generic.f90 @ 254

Last change on this file since 254 was 254, checked in by ymipsl, 10 years ago

Adding xios output functionnalities

YM
File size: 17.2 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    CALL initialize_unstructured_physics(nbp_phys,llm, comm_icosa, mpi_size,distrib,            &
124                                         day_length,start_day,itau_physics*dt,                  &
125                                         6,latfi,lonfi,airefi,bounds_lonfi,bounds_latfi,         &
126                                         radius,g, gas_constant/mu, cpp,                        &
127                                         preff, ap, bp)                                         
128   
129    CALL xios_set_context   
130   
131!    CALL init_phys_lmdz(128,97,llm, comm_icosa, mpi_size, distrib)
132   
133    CALL init_gcm_lmdz(nbp_phys,mpi_size,distrib,latfi,lonfi,airefi)
134!    CALL init_phys_lmdz(128,97,llm, comm_icosa, mpi_size, distrib)
135!    CALL iniphysiq(llm,day_length,start_day,itau_physics*dt,     &
136!                   latfi,lonfi,airefi,radius,g, gas_constant/mu, cpp,     &
137!                   ap, bp)
138   
139   
140   
141  END SUBROUTINE init_physics
142 
143  SUBROUTINE physics(it,f_phis, f_ps, f_theta_rhodz, f_u, f_wflux, f_q)
144  USE ICOSA
145  USE time_mod
146  USE disvert_mod
147  USE transfert_mod
148  USE mpipara
149  USE xios_mod
150  IMPLICIT NONE
151    INTEGER,INTENT(IN)    :: it
152    TYPE(t_field),POINTER :: f_phis(:)
153    TYPE(t_field),POINTER :: f_ps(:)
154    TYPE(t_field),POINTER :: f_theta_rhodz(:)
155    TYPE(t_field),POINTER :: f_u(:)
156    TYPE(t_field),POINTER :: f_wflux(:)
157    TYPE(t_field),POINTER :: f_q(:)
158 
159    REAL(rstd),POINTER :: phis(:)
160    REAL(rstd),POINTER :: ps(:)
161    REAL(rstd),POINTER :: theta_rhodz(:,:)
162    REAL(rstd),POINTER :: u(:,:)
163    REAL(rstd),POINTER :: wflux(:,:)
164    REAL(rstd),POINTER :: q(:,:,:)
165    REAL(rstd),POINTER :: p(:,:)
166    REAL(rstd),POINTER :: pks(:)
167    REAL(rstd),POINTER :: pk(:,:)
168    REAL(rstd),POINTER :: p_layer(:,:)
169    REAL(rstd),POINTER :: theta(:,:)
170    REAL(rstd),POINTER :: phi(:,:)
171    REAL(rstd),POINTER :: Temp(:,:)
172    REAL(rstd),POINTER :: ulon(:,:)
173    REAL(rstd),POINTER :: ulat(:,:)
174    REAL(rstd),POINTER :: dulon(:,:)
175    REAL(rstd),POINTER :: dulat(:,:)
176    REAL(rstd),POINTER :: dTemp(:,:)
177    REAL(rstd),POINTER :: dq(:,:,:)
178    REAL(rstd),POINTER :: dps(:)
179    REAL(rstd),POINTER :: duc(:,:,:)
180
181
182    INTEGER :: ind
183   
184    REAL(rstd),ALLOCATABLE,SAVE :: ps_phy(:)
185    REAL(rstd),ALLOCATABLE,SAVE :: p_phy(:,:)
186    REAL(rstd),ALLOCATABLE,SAVE :: p_layer_phy(:,:)
187    REAL(rstd),ALLOCATABLE,SAVE :: Temp_phy(:,:)
188    REAL(rstd),ALLOCATABLE,SAVE :: phis_phy(:)
189    REAL(rstd),ALLOCATABLE,SAVE :: phi_phy(:,:)
190    REAL(rstd),ALLOCATABLE,SAVE :: ulon_phy(:,:)
191    REAL(rstd),ALLOCATABLE,SAVE :: ulat_phy(:,:)
192    REAL(rstd),ALLOCATABLE,SAVE :: q_phy(:,:,:)
193    REAL(rstd),ALLOCATABLE,SAVE :: wflux_phy(:,:)
194    REAL(rstd),ALLOCATABLE,SAVE :: dulon_phy(:,:)
195    REAL(rstd),ALLOCATABLE,SAVE :: dulat_phy(:,:)
196    REAL(rstd),ALLOCATABLE,SAVE :: dTemp_phy(:,:)
197    REAL(rstd),ALLOCATABLE,SAVE :: dq_phy(:,:,:)
198    REAL(rstd),ALLOCATABLE,SAVE :: dps_phy(:)
199    REAL(rstd) :: dtphy 
200    REAL(rstd) :: time
201    REAL(rstd) :: day
202    REAL(rstd) :: real_time
203    INTEGER    :: offset
204    LOGICAL :: lafin=.FALSE.
205    LOGICAL,SAVE :: first=.TRUE.
206!$OMP THREADPRIVATE(first)
207
208   
209    IF (first) THEN
210      first=.FALSE.
211      CALL init_message(f_u,req_e1_vect,req_u)
212!$OMP MASTER
213      ALLOCATE(ps_phy(nbp_phys))
214      ALLOCATE(p_phy(nbp_phys,llm+1))
215      ALLOCATE(p_layer_phy(nbp_phys,llm))
216      ALLOCATE(Temp_phy(nbp_phys,llm))
217      ALLOCATE(phis_phy(nbp_phys))
218      ALLOCATE(phi_phy(nbp_phys,llm))
219      ALLOCATE(ulon_phy(nbp_phys,llm))
220      ALLOCATE(ulat_phy(nbp_phys,llm))
221      ALLOCATE(q_phy(nbp_phys,llm,nqtot))
222      ALLOCATE(wflux_phy(nbp_phys,llm))
223      ALLOCATE(dulon_phy(nbp_phys,llm))
224      ALLOCATE(dulat_phy(nbp_phys,llm))
225      ALLOCATE(dTemp_phy(nbp_phys,llm))
226      ALLOCATE(dq_phy(nbp_phys,llm,nqtot))
227      ALLOCATE(dps_phy(nbp_phys))
228     
229!$OMP END MASTER
230!$OMP BARRIER
231    ENDIF
232
233!$OMP MASTER       
234!    CALL update_calendar(it)
235!$OMP END MASTER
236!$OMP BARRIER
237    dtphy=itau_physics*dt
238    real_time=start_day*day_length+it*dt
239    day  = INT( MODULO(real_time,year_length) / day_length) 
240    time = MODULO(real_time,day_length) / day_length
241
242!$OMP MASTER   
243    IF (is_mpi_root) PRINT*,"Enterring in physic : day", day, "  time : ",time 
244!$OMP END MASTER   
245   
246   
247   
248   
249    CALL transfert_message(f_u,req_u)
250   
251    DO ind=1,ndomain
252      CALL swap_dimensions(ind)
253      IF (assigned_domain(ind)) THEN
254        offset=domain_offset(ind)
255        CALL swap_geometry(ind)
256     
257        phis=f_phis(ind)
258        ps=f_ps(ind)
259        theta_rhodz=f_theta_rhodz(ind)
260        u=f_u(ind)
261        q=f_q(ind)
262        wflux=f_wflux(ind)
263        p=f_p(ind)
264        pks=f_pks(ind)
265        pk=f_pk(ind)
266        p_layer=f_p_layer(ind)
267        theta=f_theta(ind)
268        phi=f_phi(ind)
269        Temp=f_Temp(ind)
270        ulon=f_ulon(ind)
271        ulat=f_ulat(ind)
272           
273        CALL grid_icosa_to_physics
274
275      ENDIF
276    ENDDO
277
278!$OMP BARRIER
279!$OMP MASTER
280    CALL SYSTEM_CLOCK(start_clock)
281!$OMP END MASTER
282    CALL calfis_icosa(dtphy, lafin, day, time, presnivs,      &
283                      p_phy, p_layer_phy, phi_phy, phis_phy, ulon_phy, ulat_phy, Temp_phy, q_phy, wflux_phy, &
284                      dulon_phy, dulat_phy, dTemp_phy, dq_phy, dps_phy  )
285
286
287!$OMP MASTER
288    CALL SYSTEM_CLOCK(stop_clock)
289    count_clock=count_clock+stop_clock-start_clock
290!$OMP END MASTER
291
292!$OMP BARRIER                       
293
294    DO ind=1,ndomain
295      CALL swap_dimensions(ind)
296      IF (assigned_domain(ind)) THEN
297        CALL swap_geometry(ind)
298        offset=domain_offset(ind)
299     
300        theta_rhodz=f_theta_rhodz(ind)
301        u=f_u(ind)
302        q=f_q(ind)
303        ps=f_ps(ind)
304        dulon=f_dulon(ind)
305        dulat=f_dulat(ind)
306        Temp=f_temp(ind)
307        dTemp=f_dTemp(ind)
308        dq=f_dq(ind)
309        dps=f_dps(ind)
310        duc=f_duc(ind)
311        p=f_p(ind)
312        pks=f_pks(ind)
313        pk=f_pk(ind)
314     
315        CALL grid_physics_to_icosa
316      ENDIF
317    ENDDO
318
319!$OMP BARRIER
320    CALL xios_set_context   
321     
322  CONTAINS
323   
324    SUBROUTINE grid_physics_to_icosa
325    USE theta2theta_rhodz_mod
326    USE omp_para
327    IMPLICIT NONE
328      INTEGER :: i,j,ij,l,iq
329         
330      DO j=jj_begin,jj_end
331        DO i=ii_begin,ii_end
332          ij=(j-1)*iim+i
333          offset=offset+1
334         
335          dulon(ij,ll_begin:ll_end)=dulon_phy(offset,ll_begin:ll_end)
336          dulat(ij,ll_begin:ll_end)=dulat_phy(offset,ll_begin:ll_end)
337          dTemp(ij,ll_begin:ll_end)=dTemp_phy(offset,ll_begin:ll_end)
338          Temp(ij,ll_begin:ll_end) = Temp_phy(offset,ll_begin:ll_end)
339          dq(ij,ll_begin:ll_end,:)=dq_phy(offset,ll_begin:ll_end,:)
340          if (omp_first) dps(ij)=dps_phy(offset)
341        ENDDO
342      ENDDO
343   
344      DO l=ll_begin,ll_end
345        DO j=jj_begin,jj_end
346          DO i=ii_begin,ii_end
347            ij=(j-1)*iim+i
348            duc(ij,:,l)=dulon(ij,l)*elon_i(ij,:)+dulat(ij,l)*elat_i(ij,:)
349          ENDDO
350        ENDDO
351      ENDDO
352
353      DO l=ll_begin,ll_end
354        DO j=jj_begin,jj_end
355          DO i=ii_begin,ii_end
356            ij=(j-1)*iim+i
357            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,:) )
358            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,:) )
359            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,:) )
360          ENDDO
361        ENDDO
362      ENDDO         
363
364      DO l=ll_begin,ll_end
365        DO j=jj_begin,jj_end
366          DO i=ii_begin,ii_end
367            ij=(j-1)*iim+i
368            Temp(ij,l)=Temp(ij,l)+ dtphy * dTemp(ij,l)
369          ENDDO
370        ENDDO
371      ENDDO         
372     
373      DO iq=1,nqtot
374        DO l=ll_begin,ll_end
375          DO j=jj_begin,jj_end
376            DO i=ii_begin,ii_end
377              ij=(j-1)*iim+i
378              q(ij,l,iq)=q(ij,l,iq)+ dtphy * dq(ij,l,iq)
379            ENDDO
380          ENDDO
381        ENDDO 
382      ENDDO
383
384!$OMP BARRIER
385     
386     IF (omp_first) THEN
387       DO j=jj_begin,jj_end
388         DO i=ii_begin,ii_end
389           ij=(j-1)*iim+i
390           ps(ij)=ps(ij)+ dtphy * dps(ij)
391          ENDDO
392       ENDDO
393     ENDIF
394
395!     CALL compute_temperature2theta_rhodz(ps,Temp,theta_rhodz,0)
396
397! compute pression
398!$OMP BARRIER
399      DO    l    = ll_begin,ll_endp1
400        DO j=jj_begin,jj_end
401          DO i=ii_begin,ii_end
402            ij=(j-1)*iim+i
403            p(ij,l) = ap(l) + bp(l) * ps(ij)
404          ENDDO
405        ENDDO
406      ENDDO
407
408!$OMP BARRIER
409
410! compute exner
411       
412       IF (omp_first) THEN
413         DO j=jj_begin,jj_end
414            DO i=ii_begin,ii_end
415               ij=(j-1)*iim+i
416               pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
417            ENDDO
418         ENDDO
419       ENDIF
420
421       ! 3D : pk
422       DO l = ll_begin,ll_end
423          DO j=jj_begin,jj_end
424             DO i=ii_begin,ii_end
425                ij=(j-1)*iim+i
426                pk(ij,l) = cpp * ((.5/preff)*(p(ij,l)+p(ij,l+1))) ** kappa
427             ENDDO
428          ENDDO
429       ENDDO
430
431!$OMP BARRIER
432
433!   compute theta, temperature and pression at layer
434    DO    l    = ll_begin, ll_end
435      DO j=jj_begin,jj_end
436        DO i=ii_begin,ii_end
437          ij=(j-1)*iim+i
438          theta_rhodz(ij,l) = temp(ij,l) * ((p(ij,l)-p(ij,l+1))/g) / (pk(ij,l) / cpp )
439        ENDDO
440      ENDDO
441    ENDDO
442   
443    END SUBROUTINE grid_physics_to_icosa
444   
445   
446    SUBROUTINE grid_icosa_to_physics
447    USE pression_mod
448    USE exner_mod
449    USE theta2theta_rhodz_mod
450    USE geopotential_mod
451    USE wind_mod
452    USE omp_para
453    IMPLICIT NONE
454   
455    REAL(rstd) :: uc(3)
456    INTEGER :: i,j,ij,l
457   
458
459! compute pression
460
461      DO    l    = ll_begin,ll_endp1
462        DO j=jj_begin,jj_end
463          DO i=ii_begin,ii_end
464            ij=(j-1)*iim+i
465            p(ij,l) = ap(l) + bp(l) * ps(ij)
466          ENDDO
467        ENDDO
468      ENDDO
469
470!$OMP BARRIER
471
472! compute exner
473       
474       IF (omp_first) THEN
475         DO j=jj_begin,jj_end
476            DO i=ii_begin,ii_end
477               ij=(j-1)*iim+i
478               pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
479            ENDDO
480         ENDDO
481       ENDIF
482
483       ! 3D : pk
484       DO l = ll_begin,ll_end
485          DO j=jj_begin,jj_end
486             DO i=ii_begin,ii_end
487                ij=(j-1)*iim+i
488                pk(ij,l) = cpp * ((.5/preff)*(p(ij,l)+p(ij,l+1))) ** kappa
489             ENDDO
490          ENDDO
491       ENDDO
492
493!$OMP BARRIER
494
495!   compute theta, temperature and pression at layer
496    DO    l    = ll_begin, ll_end
497      DO j=jj_begin,jj_end
498        DO i=ii_begin,ii_end
499          ij=(j-1)*iim+i
500          theta(ij,l) = theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g)
501          Temp(ij,l) = theta(ij,l) * pk(ij,l) / cpp
502          p_layer(ij,l)=preff*(pk(ij,l)/cpp)**(1./kappa) 
503        ENDDO
504      ENDDO
505    ENDDO
506
507
508!!! Compute geopotential
509       
510  ! for first layer
511  IF (omp_first) THEN
512    DO j=jj_begin,jj_end
513      DO i=ii_begin,ii_end
514        ij=(j-1)*iim+i
515        phi( ij,1 ) = phis( ij ) + theta(ij,1) * ( pks(ij) - pk(ij,1) )
516      ENDDO
517    ENDDO
518  ENDIF
519!!-> implicit flush on phi(:,1)
520         
521  ! for other layers
522   DO l = ll_beginp1, ll_end
523     DO j=jj_begin,jj_end
524       DO i=ii_begin,ii_end
525         ij=(j-1)*iim+i
526         phi(ij,l) =  0.5 * ( theta(ij,l)  + theta(ij,l-1) )  & 
527                          * (  pk(ij,l-1) -  pk(ij,l)    )
528       ENDDO
529     ENDDO
530   ENDDO       
531
532!$OMP BARRIER
533
534   DO l = 2, llm
535     DO j=jj_begin,jj_end
536! ---> Bug compilo intel ici en openmp
537! ---> Couper la boucle
538       if (j==jj_end+1) PRINT*,"this message must not be printed"
539       DO i=ii_begin,ii_end
540         ij=(j-1)*iim+i
541         phi(ij,l) = phi(ij,l)+ phi(ij,l-1)
542       ENDDO
543     ENDDO
544   ENDDO
545! --> IMPLICIT FLUSH on phi
546
547
548
549! compute wind centered lon lat compound
550    DO l=ll_begin,ll_end
551      DO j=jj_begin,jj_end
552        DO i=ii_begin,ii_end
553          ij=(j-1)*iim+i
554          uc(:)=1/Ai(ij)*                                                                                                &
555                        ( 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,:))  &
556                         + 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,:))          &
557                         + 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,:))          &
558                         + 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,:))    &
559                         + 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,:))&
560                         + 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,:)))
561          ulon(ij,l)=sum(uc(:)*elon_i(ij,:))
562          ulat(ij,l)=sum(uc(:)*elat_i(ij,:)) 
563        ENDDO
564      ENDDO
565    ENDDO
566
567!$OMP BARRIER
568
569
570     
571      DO j=jj_begin,jj_end
572        DO i=ii_begin,ii_end
573          ij=(j-1)*iim+i
574          offset=offset+1
575
576          IF (omp_first) ps_phy(offset) = ps(ij)
577          p_phy(offset,ll_begin:ll_endp1) = p(ij,ll_begin:ll_endp1)
578          p_layer_phy(offset,ll_begin:ll_end) = p_layer(ij,ll_begin:ll_end)
579          Temp_phy(offset,ll_begin:ll_end) = Temp(ij,ll_begin:ll_end)
580          IF (omp_first) phis_phy(offset) = phis(ij)
581          phi_phy(offset,ll_begin:ll_end) = phi(ij,ll_begin:ll_end)-phis(ij)
582          ulon_phy(offset,ll_begin:ll_end) = ulon(ij,ll_begin:ll_end)
583          ulat_phy(offset,ll_begin:ll_end) = ulat(ij,ll_begin:ll_end)
584          q_phy(offset,ll_begin:ll_end,:) = q(ij,ll_begin:ll_end,:)
585          wflux_phy(offset,ll_begin:ll_end) = wflux(ij,ll_begin:ll_end)
586        ENDDO
587      ENDDO
588     
589     END SUBROUTINE grid_icosa_to_physics
590
591  END SUBROUTINE physics
592 
593 
594END MODULE physics_lmdz_generic_mod
595   
596 
Note: See TracBrowser for help on using the repository browser.